From 9ee9ce7ac842fdbc61fe9b6e6e158f7dff14c4cc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 13 Mar 2024 15:31:46 +0200 Subject: [PATCH 001/157] Add reach_error to library functions --- src/util/library/libraryFunctions.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/util/library/libraryFunctions.ml b/src/util/library/libraryFunctions.ml index 53bf804b1d..92355ca89c 100644 --- a/src/util/library/libraryFunctions.ml +++ b/src/util/library/libraryFunctions.ml @@ -1029,6 +1029,7 @@ let svcomp_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__VERIFIER_nondet_int", unknown []); (* declare invalidate actions to prevent invalidating globals when extern in regression tests *) ("__VERIFIER_nondet_size_t", unknown []); (* cannot give it in sv-comp.c without including stdlib or similar *) ("__VERIFIER_assert", special [__ "exp" []] @@ fun exp -> Assert { exp; check = true; refine = get_bool "sem.assert.refine" }); (* only used if definition missing (e.g. in evalAssert transformed output) or extraspecial *) + ("reach_error", special [] @@ Abort); (* only used if definition missing (e.g. in evalAssert transformed output) or extraspecial *) ] [@@coverage off] From 4752ddf320351654aa13e8beb831736d535a2280 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 13 Mar 2024 15:32:03 +0200 Subject: [PATCH 002/157] Make some YAML witness validation messages more severe --- src/analyses/unassumeAnalysis.ml | 4 ++-- src/witness/yamlWitness.ml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/unassumeAnalysis.ml b/src/analyses/unassumeAnalysis.ml index 5895f242c9..9ec69727c0 100644 --- a/src/analyses/unassumeAnalysis.ml +++ b/src/analyses/unassumeAnalysis.ml @@ -252,13 +252,13 @@ struct | false, (LocationInvariant _ | LoopInvariant _ | PreconditionLoopInvariant _ | InvariantSet _) -> M.info_noloc ~category:Witness "disabled entry of type %s" target_type | _ -> - M.info_noloc ~category:Witness "cannot unassume entry of type %s" target_type + M.warn_noloc ~category:Witness "cannot unassume entry of type %s" target_type in List.iter (fun yaml_entry -> match YamlWitnessType.Entry.of_yaml yaml_entry with | Ok entry -> unassume_entry entry - | Error (`Msg e) -> M.info_noloc ~category:Witness "couldn't parse entry: %s" e + | Error (`Msg e) -> M.error_noloc ~category:Witness "couldn't parse entry: %s" e ) yaml_entries let emit_unassume ctx = diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index d9d39ccee1..2969997906 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -829,7 +829,7 @@ struct None | _ -> incr cnt_unsupported; - M.info_noloc ~category:Witness "cannot validate entry of type %s" target_type; + M.warn_noloc ~category:Witness "cannot validate entry of type %s" target_type; None in @@ -841,7 +841,7 @@ struct Option.to_list yaml_certificate_entry @ yaml_entry :: yaml_entries' | Error (`Msg e) -> incr cnt_error; - M.info_noloc ~category:Witness "couldn't parse entry: %s" e; + M.error_noloc ~category:Witness "couldn't parse entry: %s" e; yaml_entry :: yaml_entries' ) [] yaml_entries in From 2e22af7d31bcaaf6ca04e8337f357d2d9282aade Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 13 Mar 2024 15:51:57 +0200 Subject: [PATCH 003/157] Add ghost_variable and ghost_update to YAML witness types --- src/witness/yamlWitness.ml | 19 ++++++++++ src/witness/yamlWitnessType.ml | 68 +++++++++++++++++++++++++++++++++- 2 files changed, 86 insertions(+), 1 deletion(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 2969997906..213dd26f6f 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -141,6 +141,25 @@ struct }; metadata = metadata (); } + + let ghost_variable ~task ~variable ~type_ ~(initial): Entry.t = { + entry_type = GhostVariable { + variable; + scope = "global"; + type_; + initial; + }; + metadata = metadata ~task (); + } + + let ghost_update ~task ~location ~variable ~(expression): Entry.t = { + entry_type = GhostUpdate { + variable; + expression; + location; + }; + metadata = metadata ~task (); + } end let yaml_entries_to_file yaml_entries file = diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index de9fa151d8..6412c3e7b4 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -413,6 +413,60 @@ struct let entry_type = "precondition_loop_invariant_certificate" end +module GhostVariable = +struct + type t = { + variable: string; + scope: string; + type_: string; + initial: string; + } + + let entry_type = "ghost_variable" + + let to_yaml' {variable; scope; type_; initial} = + [ + ("variable", `String variable); + ("scope", `String scope); + ("type", `String type_); + ("initial", `String initial); + ] + + let of_yaml y = + let open GobYaml in + let+ variable = y |> find "variable" >>= to_string + and+ scope = y |> find "scope" >>= to_string + and+ type_ = y |> find "type" >>= to_string + and+ initial = y |> find "initial" >>= to_string in + {variable; scope; type_; initial} +end + +module GhostUpdate = +struct + type t = { + variable: string; + expression: string; + location: Location.t; + (* TODO: branching? *) + } + + let entry_type = "ghost_update" + + let to_yaml' {variable; expression; location} = + [ + ("variable", `String variable); + ("expression", `String expression); + ("location", Location.to_yaml location); + ] + + let of_yaml y = + let open GobYaml in + let+ variable = y |> find "variable" >>= to_string + and+ expression = y |> find "expression" >>= to_string + and+ location = y |> find "location" >>= Location.of_yaml in + {variable; expression; location} +end + (* TODO: could maybe use GADT, but adds ugly existential layer to entry type pattern matching *) module EntryType = struct @@ -424,6 +478,8 @@ struct | LoopInvariantCertificate of LoopInvariantCertificate.t | PreconditionLoopInvariantCertificate of PreconditionLoopInvariantCertificate.t | InvariantSet of InvariantSet.t + | GhostVariable of GhostVariable.t + | GhostUpdate of GhostUpdate.t let entry_type = function | LocationInvariant _ -> LocationInvariant.entry_type @@ -433,6 +489,8 @@ struct | LoopInvariantCertificate _ -> LoopInvariantCertificate.entry_type | PreconditionLoopInvariantCertificate _ -> PreconditionLoopInvariantCertificate.entry_type | InvariantSet _ -> InvariantSet.entry_type + | GhostVariable _ -> GhostVariable.entry_type + | GhostUpdate _ -> GhostUpdate.entry_type let to_yaml' = function | LocationInvariant x -> LocationInvariant.to_yaml' x @@ -442,6 +500,8 @@ struct | LoopInvariantCertificate x -> LoopInvariantCertificate.to_yaml' x | PreconditionLoopInvariantCertificate x -> PreconditionLoopInvariantCertificate.to_yaml' x | InvariantSet x -> InvariantSet.to_yaml' x + | GhostVariable x -> GhostVariable.to_yaml' x + | GhostUpdate x -> GhostUpdate.to_yaml' x let of_yaml y = let open GobYaml in @@ -467,8 +527,14 @@ struct else if entry_type = InvariantSet.entry_type then let+ x = y |> InvariantSet.of_yaml in InvariantSet x + else if entry_type = GhostVariable.entry_type then + let+ x = y |> GhostVariable.of_yaml in + GhostVariable x + else if entry_type = GhostUpdate.entry_type then + let+ x = y |> GhostUpdate.of_yaml in + GhostUpdate x else - Error (`Msg "entry_type") + Error (`Msg ("entry_type " ^ entry_type)) end module Entry = From 688c4dc2914897d72bcf8595286d2a49257ebef6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 13 Mar 2024 17:07:24 +0200 Subject: [PATCH 004/157] Add mutexGhosts analysis --- src/analyses/mutexGhosts.ml | 41 +++++++++++++++++++++++++++++++++++++ src/cdomains/lockDomain.ml | 2 +- 2 files changed, 42 insertions(+), 1 deletion(-) create mode 100644 src/analyses/mutexGhosts.ml diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml new file mode 100644 index 0000000000..fd5f9b5f00 --- /dev/null +++ b/src/analyses/mutexGhosts.ml @@ -0,0 +1,41 @@ +(** ([mutexGhosts]). *) + +open Analyses + + +module Spec = +struct + include UnitAnalysis.Spec + let name () = "mutexGhosts" + + module V = + struct + include Node + let is_write_only _ = true + end + + module Locked = + struct + include LockDomain.Mutexes + let name () = "locked" + end + module Unlocked = + struct + include LockDomain.Mutexes + let name () = "unlocked" + end + module G = Lattice.Prod (Locked) (Unlocked) + + let event ctx e octx = + begin match e with + | Events.Lock (l, _) -> + ctx.sideg ctx.prev_node (Locked.singleton l, Unlocked.bot ()) + | Events.Unlock l -> + ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.singleton l) + | _ -> () + end; + ctx.local +end + +let _ = + MCP.register_analysis ~dep:["mutexEvents"] (module Spec : MCPSpec) diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 107c1c0692..a7b3c93571 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -8,7 +8,7 @@ module IdxDom = ValueDomain.IndexDomain open GoblintCil module Mutexes = SetDomain.ToppedSet (Addr) (struct let topname = "All mutexes" end) (* TODO: AD? *) -module Simple = Lattice.Reverse (Mutexes) +module Simple = SetDomain.Reverse (Mutexes) module Priorities = IntDomain.Lifted module Lockset = From 45be1644d407c182fd2919b1403eb09ca3af2413 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 13 Mar 2024 17:30:09 +0200 Subject: [PATCH 005/157] Add YamlEntryGlobal query --- src/analyses/mCP.ml | 4 ++++ src/domains/queries.ml | 9 +++++++++ src/framework/constraints.ml | 24 ++++++++++++++++++++++++ src/witness/yamlWitness.ml | 20 ++++++++++++++++++++ src/witness/yamlWitnessType.ml | 30 ++++++++++++++++++++++++++++++ 5 files changed, 87 insertions(+) diff --git a/src/analyses/mCP.ml b/src/analyses/mCP.ml index a3943651c0..8f66f8049d 100644 --- a/src/analyses/mCP.ml +++ b/src/analyses/mCP.ml @@ -283,6 +283,10 @@ struct (* InvariantGlobal is special: it only goes to corresponding analysis and the argument variant is unlifted for it *) let (n, g): V.t = Obj.obj g in f ~q:(InvariantGlobal (Obj.repr g)) (Result.top ()) (n, spec n, assoc n ctx.local) + | Queries.YamlEntryGlobal (g, task) -> + (* YamlEntryGlobal is special: it only goes to corresponding analysis and the argument variant is unlifted for it *) + let (n, g): V.t = Obj.obj g in + f ~q:(YamlEntryGlobal (Obj.repr g, task)) (Result.top ()) (n, spec n, assoc n ctx.local) | Queries.PartAccess a -> Obj.repr (access ctx a) | Queries.IterSysVars (vq, fi) -> diff --git a/src/domains/queries.ml b/src/domains/queries.ml index f5fc832a9e..cc63e5fc0d 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -63,6 +63,8 @@ type invariant_context = Invariant.context = { } [@@deriving ord, hash] +module YS = SetDomain.ToppedSet (YamlWitnessType.Entry) (struct let topname = "Top" end) + (** GADT for queries with specific result type. *) type _ t = @@ -126,6 +128,7 @@ type _ t = | MustTermAllLoops: MustBool.t t | IsEverMultiThreaded: MayBool.t t | TmpSpecial: Mval.Exp.t -> ML.t t + | YamlEntryGlobal: Obj.t * YamlWitnessType.Task.t -> YS.t t type 'a result = 'a @@ -195,6 +198,7 @@ struct | MustTermAllLoops -> (module MustBool) | IsEverMultiThreaded -> (module MayBool) | TmpSpecial _ -> (module ML) + | YamlEntryGlobal _ -> (module YS) (** Get bottom result for query. *) let bot (type a) (q: a t): a result = @@ -263,6 +267,7 @@ struct | MustTermAllLoops -> MustBool.top () | IsEverMultiThreaded -> MayBool.top () | TmpSpecial _ -> ML.top () + | YamlEntryGlobal _ -> YS.top () end (* The type any_query can't be directly defined in Any as t, @@ -328,6 +333,7 @@ struct | Any IsEverMultiThreaded -> 55 | Any (TmpSpecial _) -> 56 | Any (IsAllocVar _) -> 57 + | Any (YamlEntryGlobal _) -> 58 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -375,6 +381,7 @@ struct | Any (WarnGlobal vi1), Any (WarnGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (InvariantGlobal vi1), Any (InvariantGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) + | Any (YamlEntryGlobal (vi1, task1)), Any (YamlEntryGlobal (vi2, task2)) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) (* TODO: compare task *) | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) | Any (MutexType m1), Any (MutexType m2) -> Mval.Unit.compare m1 m2 | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 @@ -418,6 +425,7 @@ struct | Any (Invariant i) -> hash_invariant_context i | Any (MutexType m) -> Mval.Unit.hash m | Any (InvariantGlobal vi) -> Hashtbl.hash vi + | Any (YamlEntryGlobal (vi, task)) -> Hashtbl.hash vi (* TODO: hash task *) | Any (MustProtectedVars m) -> hash_mustprotectedvars m | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e | Any (MustBeSingleThreaded {since_start}) -> Hashtbl.hash since_start @@ -474,6 +482,7 @@ struct | Any (WarnGlobal vi) -> Pretty.dprintf "WarnGlobal _" | Any (IterSysVars _) -> Pretty.dprintf "IterSysVars _" | Any (InvariantGlobal i) -> Pretty.dprintf "InvariantGlobal _" + | Any (YamlEntryGlobal (i, task)) -> Pretty.dprintf "YamlEntryGlobal _" | Any (MutexType (v,o)) -> Pretty.dprintf "MutexType _" | Any (EvalMutexAttr a) -> Pretty.dprintf "EvalMutexAttr _" | Any MayAccessed -> Pretty.dprintf "MayAccessed" diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index 52022b8aee..367386c6f1 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -1250,6 +1250,14 @@ struct | `Right g -> Queries.Result.top q end + | YamlEntryGlobal (g, task) -> + let g: V.t = Obj.obj g in + begin match g with + | `Left g -> + S.query (conv ctx) (YamlEntryGlobal (Obj.repr g, task)) + | `Right g -> + Queries.Result.top q + end | IterSysVars (vq, vf) -> (* vars for S *) let vf' x = vf (Obj.repr (V.s (Obj.obj x))) in @@ -1365,6 +1373,14 @@ struct | _ -> Queries.Result.top q end + | YamlEntryGlobal (g, task) -> + let g: V.t = Obj.obj g in + begin match g with + | `Left g -> + S.query (conv ctx) (YamlEntryGlobal (Obj.repr g, task)) + | _ -> + Queries.Result.top q + end | IterSysVars (vq, vf) -> (* vars for S *) let vf' x = vf (Obj.repr (V.s (Obj.obj x))) in @@ -1650,6 +1666,14 @@ struct | `Right v -> Queries.Result.top q end + | YamlEntryGlobal (v, task) -> + let v: V.t = Obj.obj v in + begin match v with + | `Left v -> + S.query (conv ctx) (YamlEntryGlobal (Obj.repr v, task)) + | `Right v -> + Queries.Result.top q + end | _ -> S.query (conv ctx) q let branch ctx = S.branch (conv ctx) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 213dd26f6f..6ea8cc6c78 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -359,6 +359,26 @@ struct entries in + (* Generate flow-insensitive invariants *) + let entries = + if true then ( + GHT.fold (fun g v acc -> + match g with + | `Left g -> (* Spec global *) + begin match R.ask_global (YamlEntryGlobal (Obj.repr g, task)) with + | `Lifted _ as inv -> + Queries.YS.fold List.cons inv acc + | `Top -> + acc + end + | `Right _ -> (* contexts global *) + acc + ) gh entries + ) + else + entries + in + (* Generate precondition invariants. We do this in three steps: 1. Collect contexts for each function diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 6412c3e7b4..823fc993ce 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -9,6 +9,7 @@ struct command_line: string option; (* TODO: description *) } + [@@deriving eq, ord, hash] let to_yaml {name; version; command_line} = `O ([ @@ -39,6 +40,7 @@ struct language: string; specification: string option; } + [@@deriving eq, ord, hash] let to_yaml {input_files; input_file_hashes; data_model; language; specification} = `O ([ @@ -78,6 +80,7 @@ struct producer: Producer.t; task: Task.t option; } + [@@deriving eq, ord, hash] let to_yaml {format_version; uuid; creation_time; producer; task} = `O ([ @@ -111,6 +114,7 @@ struct column: int; function_: string; } + [@@deriving eq, ord, hash] let to_yaml {file_name; file_hash; line; column; function_} = `O [ @@ -138,6 +142,7 @@ struct type_: string; format: string; } + [@@deriving eq, ord, hash] let to_yaml {string; type_; format} = `O [ @@ -160,6 +165,7 @@ struct location: Location.t; loop_invariant: Invariant.t; } + [@@deriving eq, ord, hash] let entry_type = "loop_invariant" @@ -182,6 +188,7 @@ struct location: Location.t; location_invariant: Invariant.t; } + [@@deriving eq, ord, hash] let entry_type = "location_invariant" @@ -203,6 +210,7 @@ struct type t = { flow_insensitive_invariant: Invariant.t; } + [@@deriving eq, ord, hash] let entry_type = "flow_insensitive_invariant" @@ -224,6 +232,7 @@ struct loop_invariant: Invariant.t; precondition: Invariant.t; } + [@@deriving eq, ord, hash] let entry_type = "precondition_loop_invariant" @@ -251,6 +260,7 @@ struct value: string; format: string; } + [@@deriving eq, ord, hash] let invariant_type = "loop_invariant" @@ -282,6 +292,7 @@ struct type t = | LocationInvariant of LocationInvariant.t | LoopInvariant of LoopInvariant.t + [@@deriving eq, ord, hash] let invariant_type = function | LocationInvariant _ -> LocationInvariant.invariant_type @@ -309,6 +320,7 @@ struct type t = { invariant_type: InvariantType.t; } + [@@deriving eq, ord, hash] let to_yaml {invariant_type} = `O [ @@ -327,6 +339,7 @@ struct type t = { content: Invariant.t list; } + [@@deriving eq, ord, hash] let entry_type = "invariant_set" @@ -346,6 +359,7 @@ struct type_: string; file_hash: string; } + [@@deriving eq, ord, hash] let to_yaml {uuid; type_; file_hash} = `O [ @@ -369,6 +383,7 @@ struct type_: string; format: string; } + [@@deriving eq, ord, hash] let to_yaml {string; type_; format} = `O [ @@ -391,6 +406,7 @@ struct target: Target.t; certification: Certification.t; } + [@@deriving eq, ord, hash] let entry_type = "loop_invariant_certificate" @@ -421,6 +437,7 @@ struct type_: string; initial: string; } + [@@deriving eq, ord, hash] let entry_type = "ghost_variable" @@ -449,6 +466,7 @@ struct location: Location.t; (* TODO: branching? *) } + [@@deriving eq, ord, hash] let entry_type = "ghost_update" @@ -480,6 +498,7 @@ struct | InvariantSet of InvariantSet.t | GhostVariable of GhostVariable.t | GhostUpdate of GhostUpdate.t + [@@deriving eq, ord, hash] let entry_type = function | LocationInvariant _ -> LocationInvariant.entry_type @@ -539,10 +558,21 @@ end module Entry = struct + include Printable.StdLeaf + type t = { entry_type: EntryType.t; metadata: Metadata.t; } + [@@deriving eq, ord, hash] + + let name () = "YAML entry" + + let show _ = "TODO" + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) let to_yaml {entry_type; metadata} = `O ([ From 5d3f5fe61d6d444d23deeb4ff91016689a3d8cfe Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 13 Mar 2024 17:38:02 +0200 Subject: [PATCH 006/157] Generate YAML witness ghosts for mutexes --- src/analyses/mutexGhosts.ml | 37 ++++++++++++++++++++++++++++++++++ src/witness/yamlWitness.ml | 7 ++++++- src/witness/yamlWitnessType.ml | 2 +- 3 files changed, 44 insertions(+), 2 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index fd5f9b5f00..fe708b8cac 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -35,6 +35,43 @@ struct | _ -> () end; ctx.local + + let query ctx (type a) (q: a Queries.t): a Queries.result = + match q with + | YamlEntryGlobal (g, task) -> + let g: V.t = Obj.obj g in + let (locked, unlocked) = ctx.global g in + let loc = Node.location g in + let location_function = (Node.find_fundec g).svar.vname in + let location = YamlWitness.Entry.location ~location:loc ~location_function in + let entries = + (* TODO: do ghost_variable-s only once *) + Locked.fold (fun l acc -> + let variable = LockDomain.Addr.show l in (* TODO: valid C name *) + let type_ = "int" in + let initial = "0" in + let entry = YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial in + Queries.YS.add entry acc + ) (Locked.union locked unlocked) (Queries.YS.empty ()) + in + let entries = + Locked.fold (fun l acc -> + let variable = LockDomain.Addr.show l in (* TODO: valid C name *) + let expression = "1" in + let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in + Queries.YS.add entry acc + ) locked entries + in + let entries = + Unlocked.fold (fun l acc -> + let variable = LockDomain.Addr.show l in (* TODO: valid C name *) + let expression = "0" in + let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in + Queries.YS.add entry acc + ) unlocked entries + in + entries + | _ -> Queries.Result.top q end let _ = diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 6ea8cc6c78..e04a4c9744 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -367,7 +367,12 @@ struct | `Left g -> (* Spec global *) begin match R.ask_global (YamlEntryGlobal (Obj.repr g, task)) with | `Lifted _ as inv -> - Queries.YS.fold List.cons inv acc + Queries.YS.fold (fun entry acc -> + if BatList.mem_cmp YamlWitnessType.Entry.compare entry acc then (* TODO: be efficient *) + acc + else + entry :: acc + ) inv acc | `Top -> acc end diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 823fc993ce..4bdb730b82 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -562,7 +562,7 @@ struct type t = { entry_type: EntryType.t; - metadata: Metadata.t; + metadata: Metadata.t [@equal fun _ _ -> true] [@compare fun _ _ -> 0] [@hash fun _ -> 1]; } [@@deriving eq, ord, hash] From a80242ae55587538f78e4ff4c3d1b5ee6601a776 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 10:52:05 +0200 Subject: [PATCH 007/157] Make protection privatization more precise with earlyglobs --- src/analyses/basePriv.ml | 4 +-- tests/regression/13-privatized/74-mutex.t | 32 +++++++++++++++++++++++ tests/regression/13-privatized/dune | 2 ++ 3 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 tests/regression/13-privatized/74-mutex.t create mode 100644 tests/regression/13-privatized/dune diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 125429231e..f08e7d710e 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -687,8 +687,8 @@ struct if not invariant then ( if not (Param.handle_atomic && ask.f MustBeAtomic) then sideg (V.unprotected x) v; (* Delay publishing unprotected write in the atomic section. *) - if !earlyglobs then (* earlyglobs workaround for 13/60 *) - sideg (V.protected x) v + if !earlyglobs && not (ThreadFlag.is_currently_multi ask) then (* earlyglobs workaround for 13/60 *) + sideg (V.protected x) v (* Also side to protected because with earlyglobs enter_multithreaded does not side everything to protected *) (* Unlock after invariant will still side effect refined value (if protected) from CPA, because cannot distinguish from non-invariant write since W is implicit. *) ); if Param.handle_atomic && ask.f MustBeAtomic then diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t new file mode 100644 index 0000000000..21c89cd524 --- /dev/null +++ b/tests/regression/13-privatized/74-mutex.t @@ -0,0 +1,32 @@ + $ goblint --enable ana.sv-comp.functions 74-mutex.c + [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) + [Warning][Deadcode] Function 'producer' has dead code: + on line 26 (74-mutex.c:26-26) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 1 + total lines: 15 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + +Should also work with earlyglobs. +Earlyglobs shouldn't cause protected writes in multithreaded mode from being immediately published to protected invariant. + + $ goblint --enable ana.sv-comp.functions --enable exp.earlyglobs 74-mutex.c + [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) + [Warning][Deadcode] Function 'producer' has dead code: + on line 26 (74-mutex.c:26-26) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 1 + total lines: 15 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 diff --git a/tests/regression/13-privatized/dune b/tests/regression/13-privatized/dune new file mode 100644 index 0000000000..23c0dd3290 --- /dev/null +++ b/tests/regression/13-privatized/dune @@ -0,0 +1,2 @@ +(cram + (deps (glob_files *.c))) From 086e60d9dc2c81c718e78f1b444ec63467d7bdf9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 11:51:12 +0200 Subject: [PATCH 008/157] Add ask argument to BasePriv invariant_global-s --- src/analyses/base.ml | 2 +- src/analyses/basePriv.ml | 14 +++++++------- src/analyses/basePriv.mli | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 9aca9e2079..7c6b2bf73f 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1243,7 +1243,7 @@ struct (* TODO: account for single-threaded values without earlyglobs. *) match g with | `Left g' -> (* priv *) - Priv.invariant_global (priv_getg ctx.global) g' + Priv.invariant_global (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) g' | `Right _ -> (* thread return *) Invariant.none ) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index f08e7d710e..ea46e25689 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -42,7 +42,7 @@ sig val thread_join: ?force:bool -> Q.ask -> (V.t -> G.t) -> Cil.exp -> BaseComponents (D).t -> BaseComponents (D).t val thread_return: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> ThreadIdDomain.Thread.t -> BaseComponents (D).t -> BaseComponents (D).t - val invariant_global: (V.t -> G.t) -> V.t -> Invariant.t + val invariant_global: Q.ask -> (V.t -> G.t) -> V.t -> Invariant.t val invariant_vars: Q.ask -> (V.t -> G.t) -> BaseComponents (D).t -> varinfo list val init: unit -> unit @@ -131,7 +131,7 @@ struct let thread_join ?(force=false) ask get e st = st let thread_return ask get set tid st = st - let invariant_global getg g = + let invariant_global ask getg g = ValueDomain.invariant_global getg g let invariant_vars ask getg st = [] @@ -211,7 +211,7 @@ struct let thread_join ?(force=false) ask get e st = st let thread_return ask get set tid st = st - let invariant_global getg = function + let invariant_global ask getg = function | `Right g' -> (* global *) ValueDomain.invariant_global (read_unprotected_global getg) g' | _ -> (* mutex *) @@ -621,7 +621,7 @@ struct let get_mutex_inits' = CPA.find x get_mutex_inits in VD.join get_mutex_global_x' get_mutex_inits' - let invariant_global getg = function + let invariant_global ask getg = function | `Middle g -> (* global *) ValueDomain.invariant_global (read_unprotected_global getg) g | `Left _ @@ -777,7 +777,7 @@ struct vf (V.protected g); | _ -> () - let invariant_global getg g = + let invariant_global ask getg g = match g with | `Left g' -> (* unprotected *) ValueDomain.invariant_global (fun g -> getg (V.unprotected g)) g' @@ -841,7 +841,7 @@ struct open Locksets - let invariant_global getg = function + let invariant_global ask getg = function | `Right g' -> (* global *) ValueDomain.invariant_global (fun x -> GWeak.fold (fun s' tm acc -> @@ -1633,7 +1633,7 @@ struct let threadenter ask st = time "threadenter" (Priv.threadenter ask) st let threadspawn ask get set st = time "threadspawn" (Priv.threadspawn ask get set) st let iter_sys_vars getg vq vf = time "iter_sys_vars" (Priv.iter_sys_vars getg vq) vf - let invariant_global getg v = time "invariant_global" (Priv.invariant_global getg) v + let invariant_global ask getg v = time "invariant_global" (Priv.invariant_global ask getg) v let invariant_vars ask getg st = time "invariant_vars" (Priv.invariant_vars ask getg) st let thread_join ?(force=false) ask get e st = time "thread_join" (Priv.thread_join ~force ask get e) st diff --git a/src/analyses/basePriv.mli b/src/analyses/basePriv.mli index 6906e6e4e1..e176a450fa 100644 --- a/src/analyses/basePriv.mli +++ b/src/analyses/basePriv.mli @@ -31,7 +31,7 @@ sig val thread_join: ?force:bool -> Queries.ask -> (V.t -> G.t) -> Cil.exp -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t val thread_return: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> ThreadIdDomain.Thread.t -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t - val invariant_global: (V.t -> G.t) -> V.t -> Invariant.t + val invariant_global: Queries.ask -> (V.t -> G.t) -> V.t -> Invariant.t (** Provides [Queries.InvariantGlobal] result for base. Should account for all unprotected/weak values of global variables. *) From b2d09da76450c1f57909247904bb828f5cf407df Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 12:07:56 +0200 Subject: [PATCH 009/157] Add MustProtectingLocks query --- src/analyses/mutexAnalysis.ml | 3 +++ src/domains/queries.ml | 7 +++++++ 2 files changed, 10 insertions(+) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 138f65ab47..1d134425f1 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -233,6 +233,9 @@ struct true else *) Mutexes.leq mutex_lockset protecting + | Queries.MustProtectingLocks g -> + let protecting = protecting ~write:true Strong g in + Mutexes.fold Queries.AD.add protecting (Queries.AD.empty ()) | Queries.MustLockset -> let held_locks = Lockset.export_locks (Lockset.filter snd ls) in Mutexes.fold (fun addr ls -> Queries.AD.add addr ls) held_locks (Queries.AD.empty ()) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index cc63e5fc0d..3fd8c1fc87 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -117,6 +117,7 @@ type _ t = | MustJoinedThreads: ConcDomain.MustThreadSet.t t | ThreadsJoinedCleanly: MustBool.t t | MustProtectedVars: mustprotectedvars -> VS.t t + | MustProtectingLocks: CilType.Varinfo.t -> AD.t t | Invariant: invariant_context -> Invariant.t t | InvariantGlobal: Obj.t -> Invariant.t t (** Argument must be of corresponding [Spec.V.t]. *) | WarnGlobal: Obj.t -> Unit.t t (** Argument must be of corresponding [Spec.V.t]. *) @@ -187,6 +188,7 @@ struct | MustJoinedThreads -> (module ConcDomain.MustThreadSet) | ThreadsJoinedCleanly -> (module MustBool) | MustProtectedVars _ -> (module VS) + | MustProtectingLocks _ -> (module AD) | Invariant _ -> (module Invariant) | InvariantGlobal _ -> (module Invariant) | WarnGlobal _ -> (module Unit) @@ -256,6 +258,7 @@ struct | MustJoinedThreads -> ConcDomain.MustThreadSet.top () | ThreadsJoinedCleanly -> MustBool.top () | MustProtectedVars _ -> VS.top () + | MustProtectingLocks _ -> AD.top () | Invariant _ -> Invariant.top () | InvariantGlobal _ -> Invariant.top () | WarnGlobal _ -> Unit.top () @@ -334,6 +337,7 @@ struct | Any (TmpSpecial _) -> 56 | Any (IsAllocVar _) -> 57 | Any (YamlEntryGlobal _) -> 58 + | Any (MustProtectingLocks _) -> 59 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -385,6 +389,7 @@ struct | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) | Any (MutexType m1), Any (MutexType m2) -> Mval.Unit.compare m1 m2 | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 + | Any (MustProtectingLocks g1), Any (MustProtectingLocks g2) -> CilType.Varinfo.compare g1 g2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 | Any (TmpSpecial lv1), Any (TmpSpecial lv2) -> Mval.Exp.compare lv1 lv2 @@ -427,6 +432,7 @@ struct | Any (InvariantGlobal vi) -> Hashtbl.hash vi | Any (YamlEntryGlobal (vi, task)) -> Hashtbl.hash vi (* TODO: hash task *) | Any (MustProtectedVars m) -> hash_mustprotectedvars m + | Any (MustProtectingLocks g) -> CilType.Varinfo.hash g | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e | Any (MustBeSingleThreaded {since_start}) -> Hashtbl.hash since_start | Any (TmpSpecial lv) -> Mval.Exp.hash lv @@ -478,6 +484,7 @@ struct | Any MustJoinedThreads -> Pretty.dprintf "MustJoinedThreads" | Any ThreadsJoinedCleanly -> Pretty.dprintf "ThreadsJoinedCleanly" | Any (MustProtectedVars m) -> Pretty.dprintf "MustProtectedVars _" + | Any (MustProtectingLocks g) -> Pretty.dprintf "MustProtectingLocks _" | Any (Invariant i) -> Pretty.dprintf "Invariant _" | Any (WarnGlobal vi) -> Pretty.dprintf "WarnGlobal _" | Any (IterSysVars _) -> Pretty.dprintf "IterSysVars _" From 526d88aac4ee38d350d8a17b0691766c8dc37e31 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 12:08:31 +0200 Subject: [PATCH 010/157] Generate protected flow-insensitive invariants with ghosts --- src/analyses/basePriv.ml | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index ea46e25689..1863625546 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -777,12 +777,18 @@ struct vf (V.protected g); | _ -> () - let invariant_global ask getg g = + let invariant_global (ask: Q.ask) getg g = match g with | `Left g' -> (* unprotected *) ValueDomain.invariant_global (fun g -> getg (V.unprotected g)) g' - | `Right g -> (* protected *) - Invariant.none + | `Right g' -> (* protected *) + let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) + let locks = ask.f (Q.MustProtectingLocks g') in + Q.AD.fold (fun m acc -> + let variable = LockDomain.Addr.show m in (* TODO: valid C name *) + let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in + Invariant.(acc || of_exp (Lval (Var var, NoOffset))) + ) locks inv let invariant_vars ask getg st = protected_vars ask end From d536db4708977e10d9946c68fb69effb56e69b24 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 12:10:20 +0200 Subject: [PATCH 011/157] Make mutex ghost variable names distinct from mutex variables --- src/analyses/basePriv.ml | 2 +- src/analyses/mutexGhosts.ml | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 1863625546..c34808522b 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -785,7 +785,7 @@ struct let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) let locks = ask.f (Q.MustProtectingLocks g') in Q.AD.fold (fun m acc -> - let variable = LockDomain.Addr.show m in (* TODO: valid C name *) + let variable = LockDomain.Addr.show m ^ "_locked" in (* TODO: valid C name *) let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in Invariant.(acc || of_exp (Lval (Var var, NoOffset))) ) locks inv diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index fe708b8cac..1cc3cdca02 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -47,7 +47,7 @@ struct let entries = (* TODO: do ghost_variable-s only once *) Locked.fold (fun l acc -> - let variable = LockDomain.Addr.show l in (* TODO: valid C name *) + let variable = LockDomain.Addr.show l ^ "_locked" in (* TODO: valid C name *) let type_ = "int" in let initial = "0" in let entry = YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial in @@ -56,7 +56,7 @@ struct in let entries = Locked.fold (fun l acc -> - let variable = LockDomain.Addr.show l in (* TODO: valid C name *) + let variable = LockDomain.Addr.show l ^ "_locked" in (* TODO: valid C name *) let expression = "1" in let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in Queries.YS.add entry acc @@ -64,7 +64,7 @@ struct in let entries = Unlocked.fold (fun l acc -> - let variable = LockDomain.Addr.show l in (* TODO: valid C name *) + let variable = LockDomain.Addr.show l ^ "_locked" in (* TODO: valid C name *) let expression = "0" in let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in Queries.YS.add entry acc From 2eafa692f26d25897f67748a89b5c1aa9e1e9da1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 12:26:34 +0200 Subject: [PATCH 012/157] Document MutexGhosts --- src/analyses/mutexGhosts.ml | 2 +- src/goblint_lib.ml | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 1cc3cdca02..b8792a2bf8 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -1,4 +1,4 @@ -(** ([mutexGhosts]). *) +(** Analysis for generating ghost variables corresponding to mutexes ([mutexGhosts]). *) open Analyses diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index e06cc8fa08..c0de408f05 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -106,6 +106,7 @@ module MutexAnalysis = MutexAnalysis module MayLocks = MayLocks module SymbLocks = SymbLocks module Deadlock = Deadlock +module MutexGhosts = MutexGhosts (** {3 Threads} From 470ddbc8490d6daaaee397288e328a3f249ca333 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 12:36:15 +0200 Subject: [PATCH 013/157] Fix coverage build --- src/analyses/basePriv.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index c34808522b..a24c686a3a 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -787,7 +787,7 @@ struct Q.AD.fold (fun m acc -> let variable = LockDomain.Addr.show m ^ "_locked" in (* TODO: valid C name *) let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in - Invariant.(acc || of_exp (Lval (Var var, NoOffset))) + Invariant.(acc || of_exp (Lval (GoblintCil.var var))) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) locks inv let invariant_vars ask getg st = protected_vars ask From 0d5ef634d8c2b0bd3adac807b4b65e726e2d03b0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 13:38:57 +0200 Subject: [PATCH 014/157] Make mutex-meet privatization more precise with earlyglobs --- src/analyses/basePriv.ml | 7 +++-- tests/regression/13-privatized/74-mutex.t | 38 +++++++++++++++++++++-- 2 files changed, 41 insertions(+), 4 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index a24c686a3a..6e9384389b 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -329,8 +329,11 @@ struct in if not invariant then ( if M.tracing then M.tracel "priv" "WRITE GLOBAL SIDE %a = %a\n" CilType.Varinfo.pretty x VD.pretty v; - sideg (V.global x) (CPA.singleton x v) - (* Unlock after invariant will still side effect refined value (if protected) from CPA, because cannot distinguish from non-invariant write. *) + let side_cpa = CPA.singleton x v in + sideg (V.global x) side_cpa; + if !earlyglobs && not (ThreadFlag.is_currently_multi ask) then + sideg V.mutex_inits side_cpa (* Also side to inits because with earlyglobs enter_multithreaded does not side everything to inits *) + (* Unlock after invariant will still side effect refined value (if protected) from CPA, because cannot distinguish from non-invariant write. *) ); {st with cpa = cpa'} (* let write_global ask getg sideg cpa x v = diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 21c89cd524..810352de44 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -16,7 +16,41 @@ Should also work with earlyglobs. Earlyglobs shouldn't cause protected writes in multithreaded mode from being immediately published to protected invariant. - $ goblint --enable ana.sv-comp.functions --enable exp.earlyglobs 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable exp.earlyglobs 74-mutex.c + [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) + [Warning][Deadcode] Function 'producer' has dead code: + on line 26 (74-mutex.c:26-26) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 1 + total lines: 15 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + +Same with mutex-meet. + + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet 74-mutex.c + [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) + [Warning][Deadcode] Function 'producer' has dead code: + on line 26 (74-mutex.c:26-26) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 1 + total lines: 15 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + +Should also work with earlyglobs. + + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable exp.earlyglobs 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) From a714dc6d512773c046a1c5dd1f937723623d0c21 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 13:47:17 +0200 Subject: [PATCH 015/157] Generate mutex-meet flow-insensitive invariants with ghosts --- src/analyses/basePriv.ml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 6e9384389b..b28381f9c6 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -294,6 +294,20 @@ module PerMutexMeetPrivBase = struct include PerMutexPrivBase + let invariant_global ask getg = function + | `Left m' as m -> (* mutex *) + let cpa = getg m in + let inv = CPA.fold (fun v _ acc -> + let inv = ValueDomain.invariant_global (fun g -> CPA.find g cpa) v in + Invariant.(acc && inv) + ) cpa Invariant.none + in + let variable = LockDomain.Addr.show m' ^ "_locked" in (* TODO: valid C name *) + let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in + Invariant.(inv || of_exp (Lval (GoblintCil.var var))) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + | g -> (* global *) + invariant_global ask getg g + let invariant_vars ask getg (st: _ BaseDomain.basecomponents_t) = (* Mutex-meet local states contain precisely the protected global variables, so we can do fewer queries than {!protected_vars}. *) From 652aeaeaca2c07f03265024ad751ca0a83e41fe5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 17:02:54 +0200 Subject: [PATCH 016/157] Add ghost variable for multithreaded mode --- src/analyses/base.ml | 11 +++++++++-- src/analyses/mutexGhosts.ml | 28 ++++++++++++++++++++++++---- 2 files changed, 33 insertions(+), 6 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 7c6b2bf73f..7f73fd42af 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1237,13 +1237,20 @@ struct Invariant.none let query_invariant_global ctx g = - if GobConfig.get_bool "ana.base.invariant.enabled" && get_bool "exp.earlyglobs" then ( + if GobConfig.get_bool "ana.base.invariant.enabled" then ( (* Currently these global invariants are only sound with earlyglobs enabled for both single- and multi-threaded programs. Otherwise, the values of globals in single-threaded mode are not accounted for. *) (* TODO: account for single-threaded values without earlyglobs. *) match g with | `Left g' -> (* priv *) - Priv.invariant_global (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) g' + let inv = Priv.invariant_global (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) g' in + if get_bool "exp.earlyglobs" then + inv + else ( + let variable = "multithreaded" in + let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in + Invariant.(inv || of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType))) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) | `Right _ -> (* thread return *) Invariant.none ) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index b8792a2bf8..6a0b8d56e4 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -24,14 +24,21 @@ struct include LockDomain.Mutexes let name () = "unlocked" end - module G = Lattice.Prod (Locked) (Unlocked) + module MultiThread = + struct + include BoolDomain.MayBool + let name () = "multithread" + end + module G = Lattice.Prod3 (Locked) (Unlocked) (MultiThread) let event ctx e octx = begin match e with | Events.Lock (l, _) -> - ctx.sideg ctx.prev_node (Locked.singleton l, Unlocked.bot ()) + ctx.sideg ctx.prev_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ()) | Events.Unlock l -> - ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.singleton l) + ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ()) + | Events.EnterMultiThreaded -> + ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.bot (), true) | _ -> () end; ctx.local @@ -40,7 +47,7 @@ struct match q with | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in - let (locked, unlocked) = ctx.global g in + let (locked, unlocked, multithread) = ctx.global g in let loc = Node.location g in let location_function = (Node.find_fundec g).svar.vname in let location = YamlWitness.Entry.location ~location:loc ~location_function in @@ -70,6 +77,19 @@ struct Queries.YS.add entry acc ) unlocked entries in + let entries = + if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( + let variable = "multithreaded" in + let type_ = "int" in + let initial = "0" in + let entry = YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial in + let expression = "1" in + let entry' = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in + Queries.YS.add entry (Queries.YS.add entry' entries) + ) + else + entries + in entries | _ -> Queries.Result.top q end From 7c33c72abe086f984afa16439af06518063e5ed8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 17:07:53 +0200 Subject: [PATCH 017/157] Reorder disjuncts in privatized invariants in implication order This also means that the global variable is (lazily) not accessed when the condition isn't met. --- src/analyses/base.ml | 2 +- src/analyses/basePriv.ml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 7f73fd42af..a4e5ab412a 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1249,7 +1249,7 @@ struct else ( let variable = "multithreaded" in let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in - Invariant.(inv || of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType))) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + Invariant.(of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) | `Right _ -> (* thread return *) Invariant.none diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index b28381f9c6..1950c6219d 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -304,7 +304,7 @@ struct in let variable = LockDomain.Addr.show m' ^ "_locked" in (* TODO: valid C name *) let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in - Invariant.(inv || of_exp (Lval (GoblintCil.var var))) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) | g -> (* global *) invariant_global ask getg g @@ -804,7 +804,7 @@ struct Q.AD.fold (fun m acc -> let variable = LockDomain.Addr.show m ^ "_locked" in (* TODO: valid C name *) let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in - Invariant.(acc || of_exp (Lval (GoblintCil.var var))) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) locks inv let invariant_vars ask getg st = protected_vars ask From 4381e9fafa8108af5baf3d49e6e560fae0e7b7cc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 17:22:28 +0200 Subject: [PATCH 018/157] Fix MustProtectingLocks query crash with top Happened on 13-privatized/01-priv_nr --- src/analyses/basePriv.ml | 14 +++++++++----- src/analyses/mutexAnalysis.ml | 5 ++++- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 1950c6219d..a26ed3bac3 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -801,11 +801,15 @@ struct | `Right g' -> (* protected *) let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) let locks = ask.f (Q.MustProtectingLocks g') in - Q.AD.fold (fun m acc -> - let variable = LockDomain.Addr.show m ^ "_locked" in (* TODO: valid C name *) - let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in - Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) locks inv + if Q.AD.is_top locks then + Invariant.none + else ( + Q.AD.fold (fun m acc -> + let variable = LockDomain.Addr.show m ^ "_locked" in (* TODO: valid C name *) + let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in + Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) locks inv + ) let invariant_vars ask getg st = protected_vars ask end diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 1d134425f1..7e877d7dad 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -235,7 +235,10 @@ struct Mutexes.leq mutex_lockset protecting | Queries.MustProtectingLocks g -> let protecting = protecting ~write:true Strong g in - Mutexes.fold Queries.AD.add protecting (Queries.AD.empty ()) + if Mutexes.is_top protecting then + Queries.AD.top () + else + Mutexes.fold Queries.AD.add protecting (Queries.AD.empty ()) | Queries.MustLockset -> let held_locks = Lockset.export_locks (Lockset.filter snd ls) in Mutexes.fold (fun addr ls -> Queries.AD.add addr ls) held_locks (Queries.AD.empty ()) From 60a51b986900e2efa77924fb6fb83c689e6917f2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 17:27:01 +0200 Subject: [PATCH 019/157] Fix protection privatization protected invariant with no protecting mutexes Happened on 13-privatized/02-priv_rc. --- src/analyses/basePriv.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index a26ed3bac3..891e8d2183 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -799,11 +799,11 @@ struct | `Left g' -> (* unprotected *) ValueDomain.invariant_global (fun g -> getg (V.unprotected g)) g' | `Right g' -> (* protected *) - let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) let locks = ask.f (Q.MustProtectingLocks g') in - if Q.AD.is_top locks then + if Q.AD.is_top locks || Q.AD.is_empty locks then Invariant.none else ( + let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) Q.AD.fold (fun m acc -> let variable = LockDomain.Addr.show m ^ "_locked" in (* TODO: valid C name *) let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in From fd84cd95f93b82b0f062e82f5683b011a52fc09e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Mar 2024 17:31:19 +0200 Subject: [PATCH 020/157] Fix mutex-meet privatization protected invariant with no protecting mutexes Happened on 13-privatized/02-priv_rc. --- src/analyses/basePriv.ml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 891e8d2183..94f0f4092b 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -294,12 +294,15 @@ module PerMutexMeetPrivBase = struct include PerMutexPrivBase - let invariant_global ask getg = function + let invariant_global (ask: Q.ask) getg = function | `Left m' as m -> (* mutex *) let cpa = getg m in let inv = CPA.fold (fun v _ acc -> - let inv = ValueDomain.invariant_global (fun g -> CPA.find g cpa) v in - Invariant.(acc && inv) + if ask.f (MustBeProtectedBy {mutex = m'; global = v; write = true; protection = Strong}) then + let inv = ValueDomain.invariant_global (fun g -> CPA.find g cpa) v in + Invariant.(acc && inv) + else + acc ) cpa Invariant.none in let variable = LockDomain.Addr.show m' ^ "_locked" in (* TODO: valid C name *) From 516e3adc1128fef03ec49ec9bb1b03814914f462 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 15 Mar 2024 12:31:06 +0200 Subject: [PATCH 021/157] Use RichVarinfo for witness ghost variables --- src/analyses/base.ml | 3 +-- src/analyses/basePriv.ml | 6 ++---- src/analyses/mutexGhosts.ml | 8 ++++---- src/goblint_lib.ml | 1 + src/witness/witnessGhost.ml | 21 +++++++++++++++++++++ 5 files changed, 29 insertions(+), 10 deletions(-) create mode 100644 src/witness/witnessGhost.ml diff --git a/src/analyses/base.ml b/src/analyses/base.ml index a4e5ab412a..7ba0d5f706 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1247,8 +1247,7 @@ struct if get_bool "exp.earlyglobs" then inv else ( - let variable = "multithreaded" in - let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in + let var = WitnessGhost.to_varinfo Multithreaded in Invariant.(of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) | `Right _ -> (* thread return *) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 94f0f4092b..deb603a110 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -305,8 +305,7 @@ struct acc ) cpa Invariant.none in - let variable = LockDomain.Addr.show m' ^ "_locked" in (* TODO: valid C name *) - let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in + let var = WitnessGhost.to_varinfo (Locked m') in Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) | g -> (* global *) invariant_global ask getg g @@ -808,8 +807,7 @@ struct else ( let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) Q.AD.fold (fun m acc -> - let variable = LockDomain.Addr.show m ^ "_locked" in (* TODO: valid C name *) - let var = Cilfacade.create_var (GoblintCil.makeGlobalVar variable GoblintCil.intType) in + let var = WitnessGhost.to_varinfo (Locked m) in Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) locks inv ) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 6a0b8d56e4..aedbeac0d4 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -54,7 +54,7 @@ struct let entries = (* TODO: do ghost_variable-s only once *) Locked.fold (fun l acc -> - let variable = LockDomain.Addr.show l ^ "_locked" in (* TODO: valid C name *) + let variable = WitnessGhost.name_varinfo (Locked l) in let type_ = "int" in let initial = "0" in let entry = YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial in @@ -63,7 +63,7 @@ struct in let entries = Locked.fold (fun l acc -> - let variable = LockDomain.Addr.show l ^ "_locked" in (* TODO: valid C name *) + let variable = WitnessGhost.name_varinfo (Locked l) in let expression = "1" in let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in Queries.YS.add entry acc @@ -71,7 +71,7 @@ struct in let entries = Unlocked.fold (fun l acc -> - let variable = LockDomain.Addr.show l ^ "_locked" in (* TODO: valid C name *) + let variable = WitnessGhost.name_varinfo (Locked l) in let expression = "0" in let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in Queries.YS.add entry acc @@ -79,7 +79,7 @@ struct in let entries = if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( - let variable = "multithreaded" in + let variable = WitnessGhost.name_varinfo Multithreaded in let type_ = "int" in let initial = "0" in let entry = YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial in diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index c0de408f05..18a5d72aa7 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -333,6 +333,7 @@ module Graphml = Graphml module YamlWitness = YamlWitness module YamlWitnessType = YamlWitnessType +module WitnessGhost = WitnessGhost module WideningTokens = WideningTokens (** {3 Violation} diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml new file mode 100644 index 0000000000..a9d177a569 --- /dev/null +++ b/src/witness/witnessGhost.ml @@ -0,0 +1,21 @@ +(** Ghost variables for YAML witnesses. *) + +module Var = +struct + type t = + | Locked of LockDomain.Addr.t + | Multithreaded + [@@deriving eq, hash] + + let name_varinfo = function + | Locked l -> LockDomain.Addr.show l ^ "_locked" (* TODO: valid C name *) + | Multithreaded -> "multithreaded" + + (* TODO: define correct types *) +end + +include Var + +module Map = RichVarinfo.Make (Var) + +include Map From a10c973d2712c7b36a28fb176f72fcf99117e958 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 15 Mar 2024 12:54:52 +0200 Subject: [PATCH 022/157] Deduplicate witness ghost entry creation --- src/analyses/mutexGhosts.ml | 26 ++++++-------------------- src/witness/witnessGhost.ml | 22 ++++++++++++++++++++++ 2 files changed, 28 insertions(+), 20 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index aedbeac0d4..0b11355d57 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -48,43 +48,29 @@ struct | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in let (locked, unlocked, multithread) = ctx.global g in - let loc = Node.location g in - let location_function = (Node.find_fundec g).svar.vname in - let location = YamlWitness.Entry.location ~location:loc ~location_function in let entries = - (* TODO: do ghost_variable-s only once *) + (* TODO: do variable_entry-s only once *) Locked.fold (fun l acc -> - let variable = WitnessGhost.name_varinfo (Locked l) in - let type_ = "int" in - let initial = "0" in - let entry = YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial in + let entry = WitnessGhost.variable_entry ~task (Locked l) in Queries.YS.add entry acc ) (Locked.union locked unlocked) (Queries.YS.empty ()) in let entries = Locked.fold (fun l acc -> - let variable = WitnessGhost.name_varinfo (Locked l) in - let expression = "1" in - let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in + let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.one in Queries.YS.add entry acc ) locked entries in let entries = Unlocked.fold (fun l acc -> - let variable = WitnessGhost.name_varinfo (Locked l) in - let expression = "0" in - let entry = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in + let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in Queries.YS.add entry acc ) unlocked entries in let entries = if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( - let variable = WitnessGhost.name_varinfo Multithreaded in - let type_ = "int" in - let initial = "0" in - let entry = YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial in - let expression = "1" in - let entry' = YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression in + let entry = WitnessGhost.variable_entry ~task Multithreaded in + let entry' = WitnessGhost.update_entry ~task ~node:g Multithreaded GoblintCil.one in Queries.YS.add entry (Queries.YS.add entry' entries) ) else diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index a9d177a569..dd4181e467 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -12,6 +12,14 @@ struct | Multithreaded -> "multithreaded" (* TODO: define correct types *) + + let type_ = function + | Locked _ -> GoblintCil.intType + | Multithreaded -> GoblintCil.intType + + let initial = function + | Locked _ -> GoblintCil.zero + | Multithreaded -> GoblintCil.zero end include Var @@ -19,3 +27,17 @@ include Var module Map = RichVarinfo.Make (Var) include Map + +let variable_entry ~task x = + let variable = name_varinfo x in + let type_ = String.trim (CilType.Typ.show (type_ x)) in (* CIL printer puts space at the end of some types *) + let initial = CilType.Exp.show (initial x) in + YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial + +let update_entry ~task ~node x e = + let loc = Node.location node in + let location_function = (Node.find_fundec node).svar.vname in + let location = YamlWitness.Entry.location ~location:loc ~location_function in + let variable = name_varinfo x in + let expression = CilType.Exp.show e in + YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression From 932ac3b312a77d09a683fa651ab114e30aec1b1e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 15 Mar 2024 13:00:59 +0200 Subject: [PATCH 023/157] Allow non-void types for RichVarinfo --- src/analyses/basePriv.ml | 2 +- src/analyses/wrapperFunctionAnalysis.ml | 2 ++ src/common/util/richVarinfo.ml | 9 +++++---- src/common/util/richVarinfo.mli | 3 ++- src/witness/witnessGhost.ml | 6 ++---- 5 files changed, 12 insertions(+), 10 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index deb603a110..cafa84eb79 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -951,7 +951,7 @@ struct (* sync: M -> (2^M -> (G -> D)) *) include AbstractLockCenteredBase (ThreadMap) (LockCenteredBase.CPA) - let global_init_thread = RichVarinfo.single ~name:"global_init" + let global_init_thread = RichVarinfo.single ~name:"global_init" ~typ:GoblintCil.voidType let current_thread (ask: Q.ask): Thread.t = if !AnalysisState.global_initialization then ThreadIdDomain.Thread.threadinit (global_init_thread ()) ~multiple:false diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 9510304e56..f3cf05c94d 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 typ _ = GoblintCil.voidType end module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(ThreadNode) diff --git a/src/common/util/richVarinfo.ml b/src/common/util/richVarinfo.ml index d1918c40a6..6a27339eed 100644 --- a/src/common/util/richVarinfo.ml +++ b/src/common/util/richVarinfo.ml @@ -1,9 +1,9 @@ open GoblintCil -let create_var name = Cilfacade.create_var @@ makeGlobalVar name voidType +let create_var name typ = Cilfacade.create_var @@ makeGlobalVar name typ -let single ~name = - let vi = lazy (create_var name) in +let single ~name ~typ = + let vi = lazy (create_var name typ) in fun () -> Lazy.force vi @@ -21,6 +21,7 @@ module type G = sig include Hashtbl.HashedType val name_varinfo: t -> string + val typ: t -> typ end module type H = @@ -47,7 +48,7 @@ struct try XH.find !xh x with Not_found -> - let vi = create_var (X.name_varinfo x) in + let vi = create_var (X.name_varinfo x) (X.typ x) in store_f x vi; vi diff --git a/src/common/util/richVarinfo.mli b/src/common/util/richVarinfo.mli index 4e682734ee..d1c002bf84 100644 --- a/src/common/util/richVarinfo.mli +++ b/src/common/util/richVarinfo.mli @@ -2,7 +2,7 @@ open GoblintCil -val single: name:string -> (unit -> varinfo) +val single: name:string -> typ:typ -> (unit -> varinfo) module type VarinfoMap = sig @@ -18,6 +18,7 @@ module type G = sig include Hashtbl.HashedType val name_varinfo: t -> string + val typ: t -> typ end module type H = diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index dd4181e467..a0d25c5be6 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -11,9 +11,7 @@ struct | Locked l -> LockDomain.Addr.show l ^ "_locked" (* TODO: valid C name *) | Multithreaded -> "multithreaded" - (* TODO: define correct types *) - - let type_ = function + let typ = function | Locked _ -> GoblintCil.intType | Multithreaded -> GoblintCil.intType @@ -30,7 +28,7 @@ include Map let variable_entry ~task x = let variable = name_varinfo x in - let type_ = String.trim (CilType.Typ.show (type_ x)) in (* CIL printer puts space at the end of some types *) + let type_ = String.trim (CilType.Typ.show (typ x)) in (* CIL printer puts space at the end of some types *) let initial = CilType.Exp.show (initial x) in YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial From b0182659a02387cb57a32c67f65a4fa9331b4821 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 2 Apr 2024 12:19:24 +0300 Subject: [PATCH 024/157] Add cram test for privatized witness ghosts --- tests/regression/13-privatized/74-mutex.t | 142 +++++++++++++++++++++- 1 file changed, 140 insertions(+), 2 deletions(-) diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 810352de44..1be888426c 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -7,12 +7,81 @@ dead: 1 total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Witness] witness generation summary: + total generation entries: 9 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 unsafe: 0 total memory locations: 1 + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 34 + column: 2 + function: main + - entry_type: ghost_update + variable: m_locked + expression: "1" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 2 + function: main + - entry_type: ghost_update + variable: m_locked + expression: "1" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 20 + column: 4 + function: producer + - entry_type: ghost_update + variable: m_locked + expression: "0" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 38 + column: 2 + function: main + - entry_type: ghost_update + variable: m_locked + expression: "0" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 23 + column: 4 + function: producer + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m_locked || used == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= used && used <= 1)' + type: assertion + format: C + Should also work with earlyglobs. Earlyglobs shouldn't cause protected writes in multithreaded mode from being immediately published to protected invariant. @@ -33,7 +102,7 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm Same with mutex-meet. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -42,12 +111,81 @@ Same with mutex-meet. dead: 1 total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Witness] witness generation summary: + total generation entries: 9 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 unsafe: 0 total memory locations: 1 + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 34 + column: 2 + function: main + - entry_type: ghost_update + variable: m_locked + expression: "1" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 2 + function: main + - entry_type: ghost_update + variable: m_locked + expression: "1" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 20 + column: 4 + function: producer + - entry_type: ghost_update + variable: m_locked + expression: "0" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 38 + column: 2 + function: main + - entry_type: ghost_update + variable: m_locked + expression: "0" + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 23 + column: 4 + function: producer + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m_locked || used == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= used && used <= 1)' + type: assertion + format: C + Should also work with earlyglobs. $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable exp.earlyglobs 74-mutex.c From 7992462268c057f2a26a1f5cfeeab7c0c704e5e4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 2 Apr 2024 13:42:29 +0300 Subject: [PATCH 025/157] Add cram test for witness ghosts with multiple protecting locks --- .../56-witness/64-ghost-multiple-protecting.c | 30 ++ .../56-witness/64-ghost-multiple-protecting.t | 450 ++++++++++++++++++ 2 files changed, 480 insertions(+) create mode 100644 tests/regression/56-witness/64-ghost-multiple-protecting.c create mode 100644 tests/regression/56-witness/64-ghost-multiple-protecting.t diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.c b/tests/regression/56-witness/64-ghost-multiple-protecting.c new file mode 100644 index 0000000000..0485cd124e --- /dev/null +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.c @@ -0,0 +1,30 @@ +#include + +int g1, g2; +pthread_mutex_t m1 = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t m2 = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m1); + pthread_mutex_lock(&m2); + g1 = 1; + g1 = 0; + pthread_mutex_unlock(&m2); + pthread_mutex_unlock(&m1); + + pthread_mutex_lock(&m1); + pthread_mutex_lock(&m2); + g2 = 1; + pthread_mutex_unlock(&m2); + pthread_mutex_lock(&m2); + g2 = 0; + pthread_mutex_unlock(&m2); + pthread_mutex_unlock(&m1); + return NULL; +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + return 0; +} diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t new file mode 100644 index 0000000000..7a413332a2 --- /dev/null +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -0,0 +1,450 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 19 + dead: 0 + total lines: 19 + [Info][Witness] witness generation summary: + total generation entries: 18 + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 0 + total memory locations: 2 + +protection doesn't have precise protected invariant for g2. + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 28 + column: 2 + function: main + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 19 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 16 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 9 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 21 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 18 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 12 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 15 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 8 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 22 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 13 + column: 2 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m2_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m1_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m2_locked || (m1_locked || g1 == 0))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m2_locked || (m1_locked || (0 <= g2 && g2 <= 1)))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g2 && g2 <= 1)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g1 && g1 <= 1)' + type: assertion + format: C + + $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 19 + dead: 0 + total lines: 19 + [Info][Witness] witness generation summary: + total generation entries: 18 + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 0 + total memory locations: 2 + +protection-read has precise protected invariant for g2. + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 28 + column: 2 + function: main + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 19 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 16 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 9 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 21 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 18 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 12 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 15 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 8 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 22 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 13 + column: 2 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m2_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m1_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m2_locked || (m1_locked || g2 == 0))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m2_locked || (m1_locked || g1 == 0))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g2 && g2 <= 1)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g1 && g1 <= 1)' + type: assertion + format: C + + $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 19 + dead: 0 + total lines: 19 + [Info][Witness] witness generation summary: + total generation entries: 18 + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 0 + total memory locations: 2 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 28 + column: 2 + function: main + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 19 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 16 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 9 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 21 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 18 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 12 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 15 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 8 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 22 + column: 2 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 13 + column: 2 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m2_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m1_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m2_locked || ((0 <= g2 && g2 <= 1) && g1 == 0))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m1_locked || (g1 == 0 && g2 == 0))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g2 && g2 <= 1)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g1 && g1 <= 1)' + type: assertion + format: C From 01c9b98fc839e3591d2111b279a99765e34af6ff Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 2 Apr 2024 14:55:35 +0300 Subject: [PATCH 026/157] mutex-meet ghost invariants are maybe unsound --- .../56-witness/64-ghost-multiple-protecting.c | 11 +++ .../56-witness/64-ghost-multiple-protecting.t | 68 ++++++++++--------- 2 files changed, 46 insertions(+), 33 deletions(-) diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.c b/tests/regression/56-witness/64-ghost-multiple-protecting.c index 0485cd124e..b19ab18ad5 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.c +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.c @@ -1,4 +1,5 @@ #include +#include int g1, g2; pthread_mutex_t m1 = PTHREAD_MUTEX_INITIALIZER; @@ -26,5 +27,15 @@ void *t_fun(void *arg) { int main() { pthread_t id; pthread_create(&id, NULL, t_fun, NULL); + + /* pthread_mutex_lock(&m1); + __goblint_check(g1 == 0); + __goblint_check(g2 == 0); + pthread_mutex_unlock(&m1); + + pthread_mutex_lock(&m2); + __goblint_check(g1 == 0); + __goblint_check(g2 == 0); + pthread_mutex_unlock(&m2); */ return 0; } diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t index 7a413332a2..b221d65ef1 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.t +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -20,7 +20,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 28 + line: 29 column: 2 function: main - entry_type: ghost_update @@ -29,7 +29,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 19 + line: 20 column: 2 function: t_fun - entry_type: ghost_update @@ -38,7 +38,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 16 + line: 17 column: 2 function: t_fun - entry_type: ghost_update @@ -47,7 +47,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 9 + line: 10 column: 2 function: t_fun - entry_type: ghost_update @@ -56,7 +56,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 21 + line: 22 column: 2 function: t_fun - entry_type: ghost_update @@ -65,7 +65,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 18 + line: 19 column: 2 function: t_fun - entry_type: ghost_update @@ -74,7 +74,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 12 + line: 13 column: 2 function: t_fun - entry_type: ghost_update @@ -83,7 +83,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 15 + line: 16 column: 2 function: t_fun - entry_type: ghost_update @@ -92,7 +92,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 8 + line: 9 column: 2 function: t_fun - entry_type: ghost_update @@ -101,7 +101,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 22 + line: 23 column: 2 function: t_fun - entry_type: ghost_update @@ -110,7 +110,7 @@ protection doesn't have precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 13 + line: 14 column: 2 function: t_fun - entry_type: ghost_variable @@ -171,7 +171,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 28 + line: 29 column: 2 function: main - entry_type: ghost_update @@ -180,7 +180,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 19 + line: 20 column: 2 function: t_fun - entry_type: ghost_update @@ -189,7 +189,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 16 + line: 17 column: 2 function: t_fun - entry_type: ghost_update @@ -198,7 +198,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 9 + line: 10 column: 2 function: t_fun - entry_type: ghost_update @@ -207,7 +207,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 21 + line: 22 column: 2 function: t_fun - entry_type: ghost_update @@ -216,7 +216,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 18 + line: 19 column: 2 function: t_fun - entry_type: ghost_update @@ -225,7 +225,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 12 + line: 13 column: 2 function: t_fun - entry_type: ghost_update @@ -234,7 +234,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 15 + line: 16 column: 2 function: t_fun - entry_type: ghost_update @@ -243,7 +243,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 8 + line: 9 column: 2 function: t_fun - entry_type: ghost_update @@ -252,7 +252,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 22 + line: 23 column: 2 function: t_fun - entry_type: ghost_update @@ -261,7 +261,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 13 + line: 14 column: 2 function: t_fun - entry_type: ghost_variable @@ -313,6 +313,8 @@ protection-read has precise protected invariant for g2. unsafe: 0 total memory locations: 2 +TODO: Are the mutex-meet invariants sound? + $ yamlWitnessStrip < witness.yml - entry_type: ghost_update variable: multithreaded @@ -320,7 +322,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 28 + line: 29 column: 2 function: main - entry_type: ghost_update @@ -329,7 +331,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 19 + line: 20 column: 2 function: t_fun - entry_type: ghost_update @@ -338,7 +340,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 16 + line: 17 column: 2 function: t_fun - entry_type: ghost_update @@ -347,7 +349,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 9 + line: 10 column: 2 function: t_fun - entry_type: ghost_update @@ -356,7 +358,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 21 + line: 22 column: 2 function: t_fun - entry_type: ghost_update @@ -365,7 +367,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 18 + line: 19 column: 2 function: t_fun - entry_type: ghost_update @@ -374,7 +376,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 12 + line: 13 column: 2 function: t_fun - entry_type: ghost_update @@ -383,7 +385,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 15 + line: 16 column: 2 function: t_fun - entry_type: ghost_update @@ -392,7 +394,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 8 + line: 9 column: 2 function: t_fun - entry_type: ghost_update @@ -401,7 +403,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 22 + line: 23 column: 2 function: t_fun - entry_type: ghost_update @@ -410,7 +412,7 @@ protection-read has precise protected invariant for g2. location: file_name: 64-ghost-multiple-protecting.c file_hash: $FILE_HASH - line: 13 + line: 14 column: 2 function: t_fun - entry_type: ghost_variable From d3a5a0a3f1f864652788ed6852a019566efead3a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 4 Apr 2024 17:05:34 +0300 Subject: [PATCH 027/157] Add NOWARNs to commented out checks in 56-witness/64-ghost-multiple-protecting --- .../regression/56-witness/64-ghost-multiple-protecting.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.c b/tests/regression/56-witness/64-ghost-multiple-protecting.c index b19ab18ad5..012318ac49 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.c +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.c @@ -29,13 +29,13 @@ int main() { pthread_create(&id, NULL, t_fun, NULL); /* pthread_mutex_lock(&m1); - __goblint_check(g1 == 0); - __goblint_check(g2 == 0); + __goblint_check(g1 == 0); // NOWARN (commented out) + __goblint_check(g2 == 0); // NOWARN (commented out) pthread_mutex_unlock(&m1); pthread_mutex_lock(&m2); - __goblint_check(g1 == 0); - __goblint_check(g2 == 0); + __goblint_check(g1 == 0); // NOWARN (commented out) + __goblint_check(g2 == 0); // NOWARN (commented out) pthread_mutex_unlock(&m2); */ return 0; } From 612c1ccd4fe756af60fde77d837781fe800493ae Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 15 Apr 2024 12:37:18 +0300 Subject: [PATCH 028/157] Remove TODO about mutex-meet unsound witness invariants --- tests/regression/56-witness/64-ghost-multiple-protecting.t | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t index b221d65ef1..619438b3e3 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.t +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -313,8 +313,6 @@ protection-read has precise protected invariant for g2. unsafe: 0 total memory locations: 2 -TODO: Are the mutex-meet invariants sound? - $ yamlWitnessStrip < witness.yml - entry_type: ghost_update variable: multithreaded From e235ba70d1b187a0395f83729ef53f667fc41e6e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 15 Apr 2024 16:25:14 +0300 Subject: [PATCH 029/157] Rewrite mutexGhosts with may locksets per node This makes 56-witness/65-ghost-ambiguous-lock have sensible ghost updates. --- src/analyses/mutexGhosts.ml | 83 +++++---- tests/regression/13-privatized/74-mutex.c | 4 +- tests/regression/13-privatized/74-mutex.t | 20 +-- .../56-witness/64-ghost-multiple-protecting.t | 6 +- .../56-witness/65-ghost-ambiguous-lock.c | 44 +++++ .../56-witness/65-ghost-ambiguous-lock.t | 166 ++++++++++++++++++ 6 files changed, 278 insertions(+), 45 deletions(-) create mode 100644 tests/regression/56-witness/65-ghost-ambiguous-lock.c create mode 100644 tests/regression/56-witness/65-ghost-ambiguous-lock.t diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 0b11355d57..ad40915e7f 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -5,49 +5,72 @@ open Analyses module Spec = struct - include UnitAnalysis.Spec - let name () = "mutexGhosts" - - module V = + (* Copied & modified from MayLocks. *) + module Arg = struct - include Node - let is_write_only _ = true - end + module D = LockDomain.MayLocksetNoRW + module V = + struct + include Node + let is_write_only _ = true + end - module Locked = - struct - include LockDomain.Mutexes - let name () = "locked" - end - module Unlocked = - struct - include LockDomain.Mutexes - let name () = "unlocked" - end - module MultiThread = - struct - include BoolDomain.MayBool - let name () = "multithread" + module Locked = + struct + include D + let name () = "locked" + end + module MultiThread = + struct + include BoolDomain.MayBool + let name () = "multithread" + end + module G = Lattice.Prod (Locked) (MultiThread) + + let add ctx (l,r) = + D.add l ctx.local + + let remove ctx l = + match D.Addr.to_mval l with + | Some (v,o) -> + (let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in + match mtype with + | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local + | _ -> ctx.local (* we cannot remove them here *)) + | None -> ctx.local (* we cannot remove them here *) end - module G = Lattice.Prod3 (Locked) (Unlocked) (MultiThread) + + include LocksetAnalysis.MakeMay (Arg) + let name () = "mutexGhosts" + + open Arg + + let sync ctx reason = + if !AnalysisState.postsolving then + ctx.sideg ctx.prev_node (ctx.local, MultiThread.bot ()); + ctx.local let event ctx e octx = begin match e with - | Events.Lock (l, _) -> - ctx.sideg ctx.prev_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ()) - | Events.Unlock l -> - ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ()) | Events.EnterMultiThreaded -> - ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.bot (), true) + ctx.sideg ctx.prev_node (Locked.bot (), true) | _ -> () end; - ctx.local + event ctx e octx (* delegate to must lockset analysis *) let query ctx (type a) (q: a Queries.t): a Queries.result = match q with | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in - let (locked, unlocked, multithread) = ctx.global g in + let module Cfg = (val !MyCFG.current_cfg) in + let next_lockset = List.fold_left (fun acc (_, next_node) -> + let (locked, _) = ctx.global next_node in + D.join acc locked + ) (D.bot ()) (Cfg.next g) + in + let (lockset, multithread) = ctx.global g in + let unlocked = D.diff lockset next_lockset in + let locked = D.diff next_lockset lockset in let entries = (* TODO: do variable_entry-s only once *) Locked.fold (fun l acc -> @@ -62,7 +85,7 @@ struct ) locked entries in let entries = - Unlocked.fold (fun l acc -> + Locked.fold (fun l acc -> let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in Queries.YS.add entry acc ) unlocked entries diff --git a/tests/regression/13-privatized/74-mutex.c b/tests/regression/13-privatized/74-mutex.c index 8ed9448b7b..7c57688238 100644 --- a/tests/regression/13-privatized/74-mutex.c +++ b/tests/regression/13-privatized/74-mutex.c @@ -29,8 +29,8 @@ void* producer() int main() { pthread_t tid; - - pthread_mutex_init(&m, 0); + pthread_mutexattr_t mutexattr; pthread_mutexattr_settype(&mutexattr, PTHREAD_MUTEX_NORMAL); + pthread_mutex_init(&m, &mutexattr); pthread_create(&tid, 0, producer, 0); pthread_mutex_lock(&m); diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index d6d7c237e4..6f84aa184f 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -1,11 +1,11 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 14 + live: 15 dead: 1 - total lines: 15 + total lines: 16 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: total generation entries: 9 @@ -90,9 +90,9 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 14 + live: 15 dead: 1 - total lines: 15 + total lines: 16 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Race] Memory locations race summary: safe: 1 @@ -102,14 +102,14 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm Same with mutex-meet. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 14 + live: 15 dead: 1 - total lines: 15 + total lines: 16 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: total generation entries: 9 @@ -193,9 +193,9 @@ Should also work with earlyglobs. [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 14 + live: 15 dead: 1 - total lines: 15 + total lines: 16 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Race] Memory locations race summary: safe: 1 diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t index 17a0a3c600..d51db2285e 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.t +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 @@ -149,7 +149,7 @@ protection doesn't have precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 @@ -300,7 +300,7 @@ protection-read has precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.c b/tests/regression/56-witness/65-ghost-ambiguous-lock.c new file mode 100644 index 0000000000..b1df0ee2e8 --- /dev/null +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.c @@ -0,0 +1,44 @@ +// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType +#include +#include + +int g1, g2; +pthread_mutex_t m1 = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t m2 = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m1); + g1 = 1; + g1 = 0; + pthread_mutex_unlock(&m1); + pthread_mutex_lock(&m2); + g2 = 1; + g2 = 0; + pthread_mutex_unlock(&m2); + return NULL; +} + +void fun(pthread_mutex_t *m) { + pthread_mutex_lock(m); + // what g2 can read? + pthread_mutex_unlock(m); +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + pthread_mutex_t *m; + int r; // rand + m = r ? &m1 : &m2; + + pthread_mutex_lock(m); + // what g1 can read? + pthread_mutex_unlock(m); + + if (r) + fun(&m1); + else + fun(&m2); + return 0; +} diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.t b/tests/regression/56-witness/65-ghost-ambiguous-lock.t new file mode 100644 index 0000000000..ee586bd531 --- /dev/null +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.t @@ -0,0 +1,166 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 65-ghost-ambiguous-lock.c + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 23 + dead: 0 + total lines: 23 + [Info][Witness] witness generation summary: + total generation entries: 20 + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 0 + total memory locations: 2 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 29 + column: 3 + function: main + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 35 + column: 3 + function: main + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: fun + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 37 + column: 3 + function: main + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 24 + column: 3 + function: fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 35 + column: 3 + function: main + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 10 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 37 + column: 3 + function: main + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 24 + column: 3 + function: fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m2_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m1_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m2_locked || g2 == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m1_locked || g1 == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g2 && g2 <= 1)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g1 && g1 <= 1)' + type: assertion + format: C From 726f646eb85ed399955cf11d78c60db56217b9d4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 15 Apr 2024 17:49:52 +0300 Subject: [PATCH 030/157] Add test for mutex ghosts for alloc variables --- .../56-witness/66-ghost-alloc-lock.c | 37 +++++ .../56-witness/66-ghost-alloc-lock.t | 134 ++++++++++++++++++ 2 files changed, 171 insertions(+) create mode 100644 tests/regression/56-witness/66-ghost-alloc-lock.c create mode 100644 tests/regression/56-witness/66-ghost-alloc-lock.t diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.c b/tests/regression/56-witness/66-ghost-alloc-lock.c new file mode 100644 index 0000000000..75d405f1ab --- /dev/null +++ b/tests/regression/56-witness/66-ghost-alloc-lock.c @@ -0,0 +1,37 @@ +// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set ana.malloc.unique_address_count 1 +#include +#include + +int g1, g2; +pthread_mutex_t *m1; +pthread_mutex_t *m2; + +void *t_fun(void *arg) { + pthread_mutex_lock(m1); + g1 = 1; + g1 = 0; + pthread_mutex_unlock(m1); + pthread_mutex_lock(m2); + g2 = 1; + g2 = 0; + pthread_mutex_unlock(m2); + return NULL; +} + +int main() { + m1 = malloc(sizeof(pthread_mutex_t)); + pthread_mutex_init(m1, NULL); + m2 = malloc(sizeof(pthread_mutex_t)); + pthread_mutex_init(m2, NULL); + + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + pthread_mutex_lock(m1); + __goblint_check(g1 == 0); + pthread_mutex_unlock(m1); + pthread_mutex_lock(m2); + __goblint_check(g2 == 0); + pthread_mutex_unlock(m2); + return 0; +} diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.t b/tests/regression/56-witness/66-ghost-alloc-lock.t new file mode 100644 index 0000000000..84c1589317 --- /dev/null +++ b/tests/regression/56-witness/66-ghost-alloc-lock.t @@ -0,0 +1,134 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set ana.malloc.unique_address_count 1 --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 66-ghost-alloc-lock.c + [Success][Assert] Assertion "g1 == 0" will succeed (66-ghost-alloc-lock.c:31:3-31:27) + [Success][Assert] Assertion "g2 == 0" will succeed (66-ghost-alloc-lock.c:34:3-34:27) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 23 + dead: 0 + total lines: 23 + [Info][Witness] witness generation summary: + total generation entries: 16 + [Info][Race] Memory locations race summary: + safe: 4 + vulnerable: 0 + unsafe: 0 + total memory locations: 4 + +TODO: valid C names for alloc mutex ghosts + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + - entry_type: ghost_update + variable: (alloc@sid:14@tid:[main](#0))_locked + expression: "1" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 33 + column: 3 + function: main + - entry_type: ghost_update + variable: (alloc@sid:14@tid:[main](#0))_locked + expression: "1" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: (alloc@sid:14@tid:[main](#0))_locked + expression: "0" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 36 + column: 10 + function: main + - entry_type: ghost_update + variable: (alloc@sid:14@tid:[main](#0))_locked + expression: "0" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 18 + column: 10 + function: t_fun + - entry_type: ghost_update + variable: (alloc@sid:11@tid:[main](#0))_locked + expression: "1" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 30 + column: 3 + function: main + - entry_type: ghost_update + variable: (alloc@sid:11@tid:[main](#0))_locked + expression: "1" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 10 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: (alloc@sid:11@tid:[main](#0))_locked + expression: "0" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 36 + column: 10 + function: main + - entry_type: ghost_update + variable: (alloc@sid:11@tid:[main](#0))_locked + expression: "0" + location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 18 + column: 10 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: (alloc@sid:14@tid:[main](#0))_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: (alloc@sid:11@tid:[main](#0))_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g2 && g2 <= 1)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g1 && g1 <= 1)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || ((alloc@sid:14@tid:[main](#0))_locked || g2 == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || ((alloc@sid:11@tid:[main](#0))_locked || g1 == 0)' + type: assertion + format: C From 3e9d7c32daffe2f818e5fa5ebf81b5a459fb40bc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 15 Apr 2024 18:05:38 +0300 Subject: [PATCH 031/157] Add valid names to alloc mutex ghosts --- src/witness/witnessGhost.ml | 10 ++++++- .../56-witness/66-ghost-alloc-lock.t | 30 +++++++++---------- 2 files changed, 23 insertions(+), 17 deletions(-) diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index a0d25c5be6..2aca886e78 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -8,7 +8,15 @@ struct [@@deriving eq, hash] let name_varinfo = function - | Locked l -> LockDomain.Addr.show l ^ "_locked" (* TODO: valid C name *) + | Locked (Addr (v, _) as l) -> + let name = + if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo v then + Printf.sprintf "alloc_%s%d" (if v.vid < 0 then "m" else "") (abs v.vid) (* turn minus into valid C name *) + else + LockDomain.Addr.show l (* TODO: valid names with interval offsets, etc *) + in + name ^ "_locked" + | Locked _ -> assert false | Multithreaded -> "multithreaded" let typ = function diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.t b/tests/regression/56-witness/66-ghost-alloc-lock.t index 84c1589317..bc3236d5a9 100644 --- a/tests/regression/56-witness/66-ghost-alloc-lock.t +++ b/tests/regression/56-witness/66-ghost-alloc-lock.t @@ -13,8 +13,6 @@ unsafe: 0 total memory locations: 4 -TODO: valid C names for alloc mutex ghosts - $ yamlWitnessStrip < witness.yml - entry_type: ghost_update variable: multithreaded @@ -26,7 +24,7 @@ TODO: valid C names for alloc mutex ghosts column: 3 function: main - entry_type: ghost_update - variable: (alloc@sid:14@tid:[main](#0))_locked + variable: alloc_m861095507_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -35,7 +33,7 @@ TODO: valid C names for alloc mutex ghosts column: 3 function: main - entry_type: ghost_update - variable: (alloc@sid:14@tid:[main](#0))_locked + variable: alloc_m861095507_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -44,7 +42,7 @@ TODO: valid C names for alloc mutex ghosts column: 3 function: t_fun - entry_type: ghost_update - variable: (alloc@sid:14@tid:[main](#0))_locked + variable: alloc_m861095507_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -53,7 +51,7 @@ TODO: valid C names for alloc mutex ghosts column: 10 function: main - entry_type: ghost_update - variable: (alloc@sid:14@tid:[main](#0))_locked + variable: alloc_m861095507_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -62,7 +60,7 @@ TODO: valid C names for alloc mutex ghosts column: 10 function: t_fun - entry_type: ghost_update - variable: (alloc@sid:11@tid:[main](#0))_locked + variable: alloc_m559918035_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -71,7 +69,7 @@ TODO: valid C names for alloc mutex ghosts column: 3 function: main - entry_type: ghost_update - variable: (alloc@sid:11@tid:[main](#0))_locked + variable: alloc_m559918035_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -80,7 +78,7 @@ TODO: valid C names for alloc mutex ghosts column: 3 function: t_fun - entry_type: ghost_update - variable: (alloc@sid:11@tid:[main](#0))_locked + variable: alloc_m559918035_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -89,7 +87,7 @@ TODO: valid C names for alloc mutex ghosts column: 10 function: main - entry_type: ghost_update - variable: (alloc@sid:11@tid:[main](#0))_locked + variable: alloc_m559918035_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -103,32 +101,32 @@ TODO: valid C names for alloc mutex ghosts type: int initial: "0" - entry_type: ghost_variable - variable: (alloc@sid:14@tid:[main](#0))_locked + variable: alloc_m861095507_locked scope: global type: int initial: "0" - entry_type: ghost_variable - variable: (alloc@sid:11@tid:[main](#0))_locked + variable: alloc_m559918035_locked scope: global type: int initial: "0" - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (0 <= g2 && g2 <= 1)' + string: '! multithreaded || (alloc_m861095507_locked || g2 == 0)' type: assertion format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (0 <= g1 && g1 <= 1)' + string: '! multithreaded || (alloc_m559918035_locked || g1 == 0)' type: assertion format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || ((alloc@sid:14@tid:[main](#0))_locked || g2 == 0)' + string: '! multithreaded || (0 <= g2 && g2 <= 1)' type: assertion format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || ((alloc@sid:11@tid:[main](#0))_locked || g1 == 0)' + string: '! multithreaded || (0 <= g1 && g1 <= 1)' type: assertion format: C From b19cc2d23ae27f5692c69da724caa703a0e12660 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 16 Apr 2024 14:01:42 +0300 Subject: [PATCH 032/157] Fix mutexGhosts indentation --- src/analyses/mutexGhosts.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index ad40915e7f..1c1a05b3b7 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -33,10 +33,11 @@ struct let remove ctx l = match D.Addr.to_mval l with | Some (v,o) -> - (let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in - match mtype with - | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local - | _ -> ctx.local (* we cannot remove them here *)) + let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in + begin match mtype with + | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local + | _ -> ctx.local (* we cannot remove them here *) + end | None -> ctx.local (* we cannot remove them here *) end From 885d0cf4b96d3aec64d90d68cd27e82867001f2a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 16 Apr 2024 14:03:09 +0300 Subject: [PATCH 033/157] Use non-recursive mutex in 56-witness/66-ghost-alloc-lock This fixes unlock ghost update locations. --- .../56-witness/66-ghost-alloc-lock.c | 6 +-- .../56-witness/66-ghost-alloc-lock.t | 40 +++++++++---------- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.c b/tests/regression/56-witness/66-ghost-alloc-lock.c index 75d405f1ab..2c1028564a 100644 --- a/tests/regression/56-witness/66-ghost-alloc-lock.c +++ b/tests/regression/56-witness/66-ghost-alloc-lock.c @@ -18,11 +18,11 @@ void *t_fun(void *arg) { return NULL; } -int main() { +int main() { pthread_mutexattr_t attr; pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_NORMAL); // https://github.com/goblint/analyzer/pull/1414 m1 = malloc(sizeof(pthread_mutex_t)); - pthread_mutex_init(m1, NULL); + pthread_mutex_init(m1, &attr); m2 = malloc(sizeof(pthread_mutex_t)); - pthread_mutex_init(m2, NULL); + pthread_mutex_init(m2, &attr); pthread_t id; pthread_create(&id, NULL, t_fun, NULL); diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.t b/tests/regression/56-witness/66-ghost-alloc-lock.t index bc3236d5a9..e4d128b71e 100644 --- a/tests/regression/56-witness/66-ghost-alloc-lock.t +++ b/tests/regression/56-witness/66-ghost-alloc-lock.t @@ -24,7 +24,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m861095507_locked + variable: alloc_m817990718_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -33,7 +33,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m861095507_locked + variable: alloc_m817990718_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -42,25 +42,25 @@ column: 3 function: t_fun - entry_type: ghost_update - variable: alloc_m861095507_locked + variable: alloc_m817990718_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c file_hash: $FILE_HASH - line: 36 - column: 10 + line: 35 + column: 3 function: main - entry_type: ghost_update - variable: alloc_m861095507_locked + variable: alloc_m817990718_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c file_hash: $FILE_HASH - line: 18 - column: 10 + line: 17 + column: 3 function: t_fun - entry_type: ghost_update - variable: alloc_m559918035_locked + variable: alloc_m334174073_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -69,7 +69,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m559918035_locked + variable: alloc_m334174073_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -78,22 +78,22 @@ column: 3 function: t_fun - entry_type: ghost_update - variable: alloc_m559918035_locked + variable: alloc_m334174073_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c file_hash: $FILE_HASH - line: 36 - column: 10 + line: 32 + column: 3 function: main - entry_type: ghost_update - variable: alloc_m559918035_locked + variable: alloc_m334174073_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c file_hash: $FILE_HASH - line: 18 - column: 10 + line: 13 + column: 3 function: t_fun - entry_type: ghost_variable variable: multithreaded @@ -101,23 +101,23 @@ type: int initial: "0" - entry_type: ghost_variable - variable: alloc_m861095507_locked + variable: alloc_m817990718_locked scope: global type: int initial: "0" - entry_type: ghost_variable - variable: alloc_m559918035_locked + variable: alloc_m334174073_locked scope: global type: int initial: "0" - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (alloc_m861095507_locked || g2 == 0)' + string: '! multithreaded || (alloc_m817990718_locked || g2 == 0)' type: assertion format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (alloc_m559918035_locked || g1 == 0)' + string: '! multithreaded || (alloc_m334174073_locked || g1 == 0)' type: assertion format: C - entry_type: flow_insensitive_invariant From 21ae83a40215d181e92d31fa81b962c0937b0534 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 16 Apr 2024 17:22:50 +0300 Subject: [PATCH 034/157] Fix mutexGhosts unlocking everything at function return --- src/analyses/mutexGhosts.ml | 21 ++++-- .../56-witness/67-ghost-no-unlock.c | 27 +++++++ .../56-witness/67-ghost-no-unlock.t | 71 +++++++++++++++++++ 3 files changed, 112 insertions(+), 7 deletions(-) create mode 100644 tests/regression/56-witness/67-ghost-no-unlock.c create mode 100644 tests/regression/56-witness/67-ghost-no-unlock.t diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 1c1a05b3b7..934b2a0c0e 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -47,8 +47,11 @@ struct open Arg let sync ctx reason = - if !AnalysisState.postsolving then - ctx.sideg ctx.prev_node (ctx.local, MultiThread.bot ()); + if !AnalysisState.postsolving then ( + match reason with + | `Return -> ctx.sideg ctx.node (ctx.local, MultiThread.bot ()) + | _ -> ctx.sideg ctx.prev_node (ctx.local, MultiThread.bot ()) + ); ctx.local let event ctx e octx = @@ -64,12 +67,16 @@ struct | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in let module Cfg = (val !MyCFG.current_cfg) in - let next_lockset = List.fold_left (fun acc (_, next_node) -> - let (locked, _) = ctx.global next_node in - D.join acc locked - ) (D.bot ()) (Cfg.next g) - in let (lockset, multithread) = ctx.global g in + let next_lockset = + match Cfg.next g with + | [] -> lockset (* HACK for return nodes *) + | nexts -> + List.fold_left (fun acc (_, next_node) -> + let (locked, _) = ctx.global next_node in + D.join acc locked + ) (D.bot ()) nexts + in let unlocked = D.diff lockset next_lockset in let locked = D.diff next_lockset lockset in let entries = diff --git a/tests/regression/56-witness/67-ghost-no-unlock.c b/tests/regression/56-witness/67-ghost-no-unlock.c new file mode 100644 index 0000000000..fc10b919d0 --- /dev/null +++ b/tests/regression/56-witness/67-ghost-no-unlock.c @@ -0,0 +1,27 @@ +// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType +#include +#include + +int g1; +pthread_mutex_t m1 = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m1); + g1 = 1; + g1 = 0; + pthread_mutex_unlock(&m1); + return NULL; +} + +int main() { + + + + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + pthread_mutex_lock(&m1); + __goblint_check(g1 == 0); + // no unlock + return 0; // there should be no ghost updates for unlock here +} diff --git a/tests/regression/56-witness/67-ghost-no-unlock.t b/tests/regression/56-witness/67-ghost-no-unlock.t new file mode 100644 index 0000000000..491dd9cf44 --- /dev/null +++ b/tests/regression/56-witness/67-ghost-no-unlock.t @@ -0,0 +1,71 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 67-ghost-no-unlock.c + [Success][Assert] Assertion "g1 == 0" will succeed (67-ghost-no-unlock.c:24:3-24:27) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Info][Witness] witness generation summary: + total generation entries: 8 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 21 + column: 3 + function: main + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 9 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 12 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m1_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m1_locked || g1 == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g1 && g1 <= 1)' + type: assertion + format: C From d67c083ba9755e6d1ecc38daaf28d3a266a1ee38 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 Apr 2024 14:49:58 +0300 Subject: [PATCH 035/157] Revert "Rewrite mutexGhosts with may locksets per node" This partially reverts commits e235ba70d1b187a0395f83729ef53f667fc41e6e and 21ae83a40215d181e92d31fa81b962c0937b0534. --- src/analyses/mutexGhosts.ml | 91 ++++++++++++------------------------- 1 file changed, 30 insertions(+), 61 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 934b2a0c0e..0b11355d57 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -5,80 +5,49 @@ open Analyses module Spec = struct - (* Copied & modified from MayLocks. *) - module Arg = - struct - module D = LockDomain.MayLocksetNoRW - module V = - struct - include Node - let is_write_only _ = true - end - - module Locked = - struct - include D - let name () = "locked" - end - module MultiThread = - struct - include BoolDomain.MayBool - let name () = "multithread" - end - module G = Lattice.Prod (Locked) (MultiThread) - - let add ctx (l,r) = - D.add l ctx.local - - let remove ctx l = - match D.Addr.to_mval l with - | Some (v,o) -> - let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in - begin match mtype with - | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local - | _ -> ctx.local (* we cannot remove them here *) - end - | None -> ctx.local (* we cannot remove them here *) - end - - include LocksetAnalysis.MakeMay (Arg) + include UnitAnalysis.Spec let name () = "mutexGhosts" - open Arg + module V = + struct + include Node + let is_write_only _ = true + end - let sync ctx reason = - if !AnalysisState.postsolving then ( - match reason with - | `Return -> ctx.sideg ctx.node (ctx.local, MultiThread.bot ()) - | _ -> ctx.sideg ctx.prev_node (ctx.local, MultiThread.bot ()) - ); - ctx.local + module Locked = + struct + include LockDomain.Mutexes + let name () = "locked" + end + module Unlocked = + struct + include LockDomain.Mutexes + let name () = "unlocked" + end + module MultiThread = + struct + include BoolDomain.MayBool + let name () = "multithread" + end + module G = Lattice.Prod3 (Locked) (Unlocked) (MultiThread) let event ctx e octx = begin match e with + | Events.Lock (l, _) -> + ctx.sideg ctx.prev_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ()) + | Events.Unlock l -> + ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ()) | Events.EnterMultiThreaded -> - ctx.sideg ctx.prev_node (Locked.bot (), true) + ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.bot (), true) | _ -> () end; - event ctx e octx (* delegate to must lockset analysis *) + ctx.local let query ctx (type a) (q: a Queries.t): a Queries.result = match q with | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in - let module Cfg = (val !MyCFG.current_cfg) in - let (lockset, multithread) = ctx.global g in - let next_lockset = - match Cfg.next g with - | [] -> lockset (* HACK for return nodes *) - | nexts -> - List.fold_left (fun acc (_, next_node) -> - let (locked, _) = ctx.global next_node in - D.join acc locked - ) (D.bot ()) nexts - in - let unlocked = D.diff lockset next_lockset in - let locked = D.diff next_lockset lockset in + let (locked, unlocked, multithread) = ctx.global g in let entries = (* TODO: do variable_entry-s only once *) Locked.fold (fun l acc -> @@ -93,7 +62,7 @@ struct ) locked entries in let entries = - Locked.fold (fun l acc -> + Unlocked.fold (fun l acc -> let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in Queries.YS.add entry acc ) unlocked entries From c472adff1fdf72a6da6142d07f55e59069f91aeb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 Apr 2024 18:00:05 +0300 Subject: [PATCH 036/157] Add lock global unknowns to mutexGhosts --- src/analyses/mutexGhosts.ml | 92 +++++++++++++++++++++++-------------- 1 file changed, 57 insertions(+), 35 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 0b11355d57..d80291532f 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -10,8 +10,12 @@ struct module V = struct - include Node - let is_write_only _ = true + include Printable.Either (Node) (LockDomain.Addr) + let node x = `Left x + let lock x = `Right x + let is_write_only = function + | `Left _ -> false + | `Right _ -> true end module Locked = @@ -29,16 +33,29 @@ struct include BoolDomain.MayBool let name () = "multithread" end - module G = Lattice.Prod3 (Locked) (Unlocked) (MultiThread) + module G = + struct + include Lattice.Lift2 (Lattice.Prod3 (Locked) (Unlocked) (MultiThread)) (Lattice.Unit) + let node = function + | `Bot -> (Locked.bot (), Unlocked.bot (), MultiThread.bot ()) + | `Lifted1 x -> x + | _ -> failwith "MutexGhosts.node" + let lock = function + | `Bot -> Lattice.Unit.bot () + | `Lifted2 x -> x + | _ -> failwith "MutexGhosts.lock" + let create_node node = `Lifted1 node + let create_lock lock = `Lifted2 lock + end let event ctx e octx = begin match e with | Events.Lock (l, _) -> - ctx.sideg ctx.prev_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ()) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ())) | Events.Unlock l -> - ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ()) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ())) | Events.EnterMultiThreaded -> - ctx.sideg ctx.prev_node (Locked.bot (), Unlocked.bot (), true) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true)) | _ -> () end; ctx.local @@ -47,36 +64,41 @@ struct match q with | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in - let (locked, unlocked, multithread) = ctx.global g in - let entries = - (* TODO: do variable_entry-s only once *) - Locked.fold (fun l acc -> - let entry = WitnessGhost.variable_entry ~task (Locked l) in - Queries.YS.add entry acc - ) (Locked.union locked unlocked) (Queries.YS.empty ()) - in - let entries = - Locked.fold (fun l acc -> - let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.one in - Queries.YS.add entry acc - ) locked entries - in - let entries = - Unlocked.fold (fun l acc -> - let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in - Queries.YS.add entry acc - ) unlocked entries - in - let entries = - if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( - let entry = WitnessGhost.variable_entry ~task Multithreaded in - let entry' = WitnessGhost.update_entry ~task ~node:g Multithreaded GoblintCil.one in - Queries.YS.add entry (Queries.YS.add entry' entries) - ) - else + begin match g with + | `Left g' -> + let (locked, unlocked, multithread) = G.node (ctx.global g) in + let g = g' in + let entries = + (* TODO: do variable_entry-s only once *) + Locked.fold (fun l acc -> + let entry = WitnessGhost.variable_entry ~task (Locked l) in + Queries.YS.add entry acc + ) (Locked.union locked unlocked) (Queries.YS.empty ()) + in + let entries = + Locked.fold (fun l acc -> + let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.one in + Queries.YS.add entry acc + ) locked entries + in + let entries = + Unlocked.fold (fun l acc -> + let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in + Queries.YS.add entry acc + ) unlocked entries + in + let entries = + if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( + let entry = WitnessGhost.variable_entry ~task Multithreaded in + let entry' = WitnessGhost.update_entry ~task ~node:g Multithreaded GoblintCil.one in + Queries.YS.add entry (Queries.YS.add entry' entries) + ) + else + entries + in entries - in - entries + | `Right _ -> assert false + end | _ -> Queries.Result.top q end From fd64898163e98115a3d3dfd253856005796c68a9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 19 Apr 2024 13:34:37 +0300 Subject: [PATCH 037/157] Add PARAM to 56-witness/64-ghost-multiple-protecting --- tests/regression/56-witness/64-ghost-multiple-protecting.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.c b/tests/regression/56-witness/64-ghost-multiple-protecting.c index 012318ac49..589aa92bff 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.c +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.c @@ -1,6 +1,6 @@ +// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType #include #include - int g1, g2; pthread_mutex_t m1 = PTHREAD_MUTEX_INITIALIZER; pthread_mutex_t m2 = PTHREAD_MUTEX_INITIALIZER; From e3ded4e20de4790baf9d9bf5b6fad2904d3ae598 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 19 Apr 2024 13:34:55 +0300 Subject: [PATCH 038/157] Find ambiguous mutexes in mutexGhosts --- src/analyses/mutexGhosts.ml | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index d80291532f..083763f41b 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -35,7 +35,7 @@ struct end module G = struct - include Lattice.Lift2 (Lattice.Prod3 (Locked) (Unlocked) (MultiThread)) (Lattice.Unit) + include Lattice.Lift2 (Lattice.Prod3 (Locked) (Unlocked) (MultiThread)) (BoolDomain.MayBool) let node = function | `Bot -> (Locked.bot (), Unlocked.bot (), MultiThread.bot ()) | `Lifted1 x -> x @@ -51,9 +51,25 @@ struct let event ctx e octx = begin match e with | Events.Lock (l, _) -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ())) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ())); + if !AnalysisState.postsolving then ( + let (locked, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in + if Locked.cardinal locked > 1 then ( + Locked.iter (fun lock -> + ctx.sideg (V.lock lock) (G.create_lock true) + ) locked + ); + ) | Events.Unlock l -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ())) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ())); + if !AnalysisState.postsolving then ( + let (_, unlocked, _) = G.node (ctx.global (V.node ctx.prev_node)) in + if Locked.cardinal unlocked > 1 then ( + Locked.iter (fun lock -> + ctx.sideg (V.lock lock) (G.create_lock true) + ) unlocked + ); + ) | Events.EnterMultiThreaded -> ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true)) | _ -> () @@ -97,7 +113,7 @@ struct entries in entries - | `Right _ -> assert false + | `Right _ -> Queries.Result.top q end | _ -> Queries.Result.top q end From b96f8a210c18fa6f1380f29d90fe53f7ad77efbe Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 19 Apr 2024 13:50:04 +0300 Subject: [PATCH 039/157] Avoid emitting witness ghosts for ambiguous mutexes --- src/analyses/base.ml | 5 +- src/analyses/basePriv.ml | 10 +- src/analyses/mutexGhosts.ml | 42 ++++-- src/domains/queries.ml | 7 + src/witness/witnessGhost.ml | 4 +- .../56-witness/65-ghost-ambiguous-lock.t | 130 +----------------- 6 files changed, 55 insertions(+), 143 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 4cc5c51262..ac31e29163 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1248,7 +1248,10 @@ struct inv else ( let var = WitnessGhost.to_varinfo Multithreaded in - Invariant.(of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + if ctx.ask (GhostVarAvailable var) then + Invariant.(of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + else + Invariant.none ) | `Right _ -> (* thread return *) Invariant.none diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 832aaf54c1..129d0d5d69 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -343,7 +343,10 @@ struct ) cpa Invariant.none in let var = WitnessGhost.to_varinfo (Locked m') in - Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + if ask.f (GhostVarAvailable var) then + Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + else + Invariant.none | g -> (* global *) invariant_global ask getg g @@ -859,7 +862,10 @@ struct let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) Q.AD.fold (fun m acc -> let var = WitnessGhost.to_varinfo (Locked m) in - Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + if ask.f (GhostVarAvailable var) then + Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + else + Invariant.none ) locks inv ) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 083763f41b..21a12db7a1 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -41,7 +41,7 @@ struct | `Lifted1 x -> x | _ -> failwith "MutexGhosts.node" let lock = function - | `Bot -> Lattice.Unit.bot () + | `Bot -> BoolDomain.MayBool.bot () | `Lifted2 x -> x | _ -> failwith "MutexGhosts.lock" let create_node node = `Lifted1 node @@ -76,8 +76,14 @@ struct end; ctx.local + let ghost_var_available ctx = function + | WitnessGhost.Var.Locked lock -> not (G.lock (ctx.global (V.lock lock)): bool) + | Multithreaded -> true + let query ctx (type a) (q: a Queries.t): a Queries.result = match q with + | GhostVarAvailable vi -> + GobOption.exists (ghost_var_available ctx) (WitnessGhost.from_varinfo vi) | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in begin match g with @@ -87,27 +93,43 @@ struct let entries = (* TODO: do variable_entry-s only once *) Locked.fold (fun l acc -> - let entry = WitnessGhost.variable_entry ~task (Locked l) in - Queries.YS.add entry acc + if ghost_var_available ctx (Locked l) then ( + let entry = WitnessGhost.variable_entry ~task (Locked l) in + Queries.YS.add entry acc + ) + else + acc ) (Locked.union locked unlocked) (Queries.YS.empty ()) in let entries = Locked.fold (fun l acc -> - let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.one in - Queries.YS.add entry acc + if ghost_var_available ctx (Locked l) then ( + let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.one in + Queries.YS.add entry acc + ) + else + acc ) locked entries in let entries = Unlocked.fold (fun l acc -> - let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in - Queries.YS.add entry acc + if ghost_var_available ctx (Locked l) then ( + let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in + Queries.YS.add entry acc + ) + else + acc ) unlocked entries in let entries = if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( - let entry = WitnessGhost.variable_entry ~task Multithreaded in - let entry' = WitnessGhost.update_entry ~task ~node:g Multithreaded GoblintCil.one in - Queries.YS.add entry (Queries.YS.add entry' entries) + if ghost_var_available ctx Multithreaded then ( + let entry = WitnessGhost.variable_entry ~task Multithreaded in + let entry' = WitnessGhost.update_entry ~task ~node:g Multithreaded GoblintCil.one in + Queries.YS.add entry (Queries.YS.add entry' entries) + ) + else + entries ) else entries diff --git a/src/domains/queries.ml b/src/domains/queries.ml index b9b13a7584..9a50af1907 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -130,6 +130,7 @@ type _ t = | TmpSpecial: Mval.Exp.t -> ML.t t | MaySignedOverflow: exp -> MayBool.t t | YamlEntryGlobal: Obj.t * YamlWitnessType.Task.t -> YS.t t + | GhostVarAvailable: varinfo -> MustBool.t t type 'a result = 'a @@ -202,6 +203,7 @@ struct | TmpSpecial _ -> (module ML) | MaySignedOverflow _ -> (module MayBool) | YamlEntryGlobal _ -> (module YS) + | GhostVarAvailable _ -> (module MustBool) (** Get bottom result for query. *) let bot (type a) (q: a t): a result = @@ -273,6 +275,7 @@ struct | TmpSpecial _ -> ML.top () | MaySignedOverflow _ -> MayBool.top () | YamlEntryGlobal _ -> YS.top () + | GhostVarAvailable _ -> MustBool.top () end (* The type any_query can't be directly defined in Any as t, @@ -341,6 +344,7 @@ struct | Any (MaySignedOverflow _) -> 58 | Any (YamlEntryGlobal _) -> 59 | Any (MustProtectingLocks _) -> 60 + | Any (GhostVarAvailable _) -> 61 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -397,6 +401,7 @@ struct | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 | Any (TmpSpecial lv1), Any (TmpSpecial lv2) -> Mval.Exp.compare lv1 lv2 | Any (MaySignedOverflow e1), Any (MaySignedOverflow e2) -> CilType.Exp.compare e1 e2 + | Any (GhostVarAvailable vi1), Any (GhostVarAvailable vi2) -> CilType.Varinfo.compare vi1 vi2 (* only argumentless queries should remain *) | _, _ -> Stdlib.compare (order a) (order b) @@ -441,6 +446,7 @@ struct | Any (MustBeSingleThreaded {since_start}) -> Hashtbl.hash since_start | Any (TmpSpecial lv) -> Mval.Exp.hash lv | Any (MaySignedOverflow e) -> CilType.Exp.hash e + | Any (GhostVarAvailable vi) -> CilType.Varinfo.hash vi (* IterSysVars: *) (* - argument is a function and functions cannot be compared in any meaningful way. *) (* - doesn't matter because IterSysVars is always queried from outside of the analysis, so MCP's query caching is not done for it. *) @@ -506,6 +512,7 @@ struct | Any IsEverMultiThreaded -> Pretty.dprintf "IsEverMultiThreaded" | Any (TmpSpecial lv) -> Pretty.dprintf "TmpSpecial %a" Mval.Exp.pretty lv | Any (MaySignedOverflow e) -> Pretty.dprintf "MaySignedOverflow %a" CilType.Exp.pretty e + | Any (GhostVarAvailable vi) -> Pretty.dprintf "GhostVarAvailable %a" CilType.Varinfo.pretty vi end let to_value_domain_ask (ask: ask) = diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index 2aca886e78..010f450954 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -19,6 +19,8 @@ struct | Locked _ -> assert false | Multithreaded -> "multithreaded" + let describe_varinfo _ _ = "" + let typ = function | Locked _ -> GoblintCil.intType | Multithreaded -> GoblintCil.intType @@ -30,7 +32,7 @@ end include Var -module Map = RichVarinfo.Make (Var) +module Map = RichVarinfo.BiVarinfoMap.Make (Var) include Map diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.t b/tests/regression/56-witness/65-ghost-ambiguous-lock.t index ee586bd531..708e27ca64 100644 --- a/tests/regression/56-witness/65-ghost-ambiguous-lock.t +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.t @@ -4,7 +4,7 @@ dead: 0 total lines: 23 [Info][Witness] witness generation summary: - total generation entries: 20 + total generation entries: 4 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -21,139 +21,11 @@ line: 29 column: 3 function: main - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 35 - column: 3 - function: main - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 22 - column: 3 - function: fun - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 14 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 37 - column: 3 - function: main - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 24 - column: 3 - function: fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 35 - column: 3 - function: main - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 22 - column: 3 - function: fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 10 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 37 - column: 3 - function: main - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 24 - column: 3 - function: fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - entry_type: ghost_variable variable: multithreaded scope: global type: int initial: "0" - - entry_type: ghost_variable - variable: m2_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m1_locked - scope: global - type: int - initial: "0" - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (m2_locked || g2 == 0)' - type: assertion - format: C - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (m1_locked || g1 == 0)' - type: assertion - format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= g2 && g2 <= 1)' From c6f12a60491f6650fcb07ba01dd54344a4a30fe3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 19 Apr 2024 13:57:06 +0300 Subject: [PATCH 040/157] Move LockDomain.Symbolic to SymbLocksDomain --- src/analyses/symbLocks.ml | 4 +-- src/cdomains/lockDomain.ml | 50 -------------------------------- src/cdomains/symbLocksDomain.ml | 51 +++++++++++++++++++++++++++++++++ 3 files changed, 53 insertions(+), 52 deletions(-) diff --git a/src/analyses/symbLocks.ml b/src/analyses/symbLocks.ml index 6fd18de6ff..b1727ace81 100644 --- a/src/analyses/symbLocks.ml +++ b/src/analyses/symbLocks.ml @@ -23,8 +23,8 @@ struct exception Top - module D = LockDomain.Symbolic - module C = LockDomain.Symbolic + module D = SymbLocksDomain.Symbolic + module C = SymbLocksDomain.Symbolic let name () = "symb_locks" diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index b22931001b..5aaa441428 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -74,53 +74,3 @@ module MayLocksetNoRW = struct include PreValueDomain.AD end - -module Symbolic = -struct - (* TODO: use SetDomain.Reverse *) - module S = SetDomain.ToppedSet (Exp) (struct let topname = "All mutexes" end) - include Lattice.Reverse (S) - - let rec eq_set (ask: Queries.ask) e = - S.union - (match ask.f (Queries.EqualSet e) with - | es when not (Queries.ES.is_bot es) -> - Queries.ES.fold S.add es (S.empty ()) - | _ -> S.empty ()) - (match e with - | SizeOf _ - | SizeOfE _ - | SizeOfStr _ - | AlignOf _ - | Const _ - | AlignOfE _ - | UnOp _ - | BinOp _ - | Question _ - | Real _ - | Imag _ - | AddrOfLabel _ -> S.empty () - | AddrOf (Var _,_) - | StartOf (Var _,_) - | Lval (Var _,_) -> S.singleton e - | AddrOf (Mem e,ofs) -> S.map (fun e -> AddrOf (Mem e,ofs)) (eq_set ask e) - | StartOf (Mem e,ofs) -> S.map (fun e -> StartOf (Mem e,ofs)) (eq_set ask e) - | Lval (Mem e,ofs) -> S.map (fun e -> Lval (Mem e,ofs)) (eq_set ask e) - | CastE (_,e) -> eq_set ask e - ) - - let add (ask: Queries.ask) e st = - let no_casts = S.map Expcompare.stripCastsDeepForPtrArith (eq_set ask e) in - let addrs = S.filter (function AddrOf _ -> true | _ -> false) no_casts in - S.union addrs st - let remove ask e st = - (* TODO: Removing based on must-equality sets is not sound! *) - let no_casts = S.map Expcompare.stripCastsDeepForPtrArith (eq_set ask e) in - let addrs = S.filter (function AddrOf _ -> true | _ -> false) no_casts in - S.diff st addrs - let remove_var v st = S.filter (fun x -> not (SymbLocksDomain.Exp.contains_var v x)) st - - let filter = S.filter - let fold = S.fold - -end diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index ba2b96e8d0..bb260ad412 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -317,3 +317,54 @@ struct let of_mval (v, o) = of_mval (v, conv_const_offset o) end + + +module Symbolic = +struct + (* TODO: use SetDomain.Reverse *) + module S = SetDomain.ToppedSet (Exp) (struct let topname = "All mutexes" end) + include Lattice.Reverse (S) + + let rec eq_set (ask: Queries.ask) e = + S.union + (match ask.f (Queries.EqualSet e) with + | es when not (Queries.ES.is_bot es) -> + Queries.ES.fold S.add es (S.empty ()) + | _ -> S.empty ()) + (match e with + | SizeOf _ + | SizeOfE _ + | SizeOfStr _ + | AlignOf _ + | Const _ + | AlignOfE _ + | UnOp _ + | BinOp _ + | Question _ + | Real _ + | Imag _ + | AddrOfLabel _ -> S.empty () + | AddrOf (Var _,_) + | StartOf (Var _,_) + | Lval (Var _,_) -> S.singleton e + | AddrOf (Mem e,ofs) -> S.map (fun e -> AddrOf (Mem e,ofs)) (eq_set ask e) + | StartOf (Mem e,ofs) -> S.map (fun e -> StartOf (Mem e,ofs)) (eq_set ask e) + | Lval (Mem e,ofs) -> S.map (fun e -> Lval (Mem e,ofs)) (eq_set ask e) + | CastE (_,e) -> eq_set ask e + ) + + let add (ask: Queries.ask) e st = + let no_casts = S.map Expcompare.stripCastsDeepForPtrArith (eq_set ask e) in + let addrs = S.filter (function AddrOf _ -> true | _ -> false) no_casts in + S.union addrs st + let remove ask e st = + (* TODO: Removing based on must-equality sets is not sound! *) + let no_casts = S.map Expcompare.stripCastsDeepForPtrArith (eq_set ask e) in + let addrs = S.filter (function AddrOf _ -> true | _ -> false) no_casts in + S.diff st addrs + let remove_var v st = S.filter (fun x -> not (Exp.contains_var v x)) st + + let filter = S.filter + let fold = S.fold + +end From 8985d64633a0b3d0f6812df8ee784c87f332f499 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 19 Apr 2024 13:57:37 +0300 Subject: [PATCH 041/157] Extract WitnessGhostVar to break dependency cycle --- src/witness/witnessGhost.ml | 30 +---------------------------- src/witness/witnessGhostVar.ml | 35 ++++++++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 29 deletions(-) create mode 100644 src/witness/witnessGhostVar.ml diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index 010f450954..cdd26b36aa 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -1,34 +1,6 @@ (** Ghost variables for YAML witnesses. *) -module Var = -struct - type t = - | Locked of LockDomain.Addr.t - | Multithreaded - [@@deriving eq, hash] - - let name_varinfo = function - | Locked (Addr (v, _) as l) -> - let name = - if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo v then - Printf.sprintf "alloc_%s%d" (if v.vid < 0 then "m" else "") (abs v.vid) (* turn minus into valid C name *) - else - LockDomain.Addr.show l (* TODO: valid names with interval offsets, etc *) - in - name ^ "_locked" - | Locked _ -> assert false - | Multithreaded -> "multithreaded" - - let describe_varinfo _ _ = "" - - let typ = function - | Locked _ -> GoblintCil.intType - | Multithreaded -> GoblintCil.intType - - let initial = function - | Locked _ -> GoblintCil.zero - | Multithreaded -> GoblintCil.zero -end +module Var = WitnessGhostVar include Var diff --git a/src/witness/witnessGhostVar.ml b/src/witness/witnessGhostVar.ml new file mode 100644 index 0000000000..afcf5d4dba --- /dev/null +++ b/src/witness/witnessGhostVar.ml @@ -0,0 +1,35 @@ +(** Ghost variables for YAML witnesses. *) + +type t = + | Locked of LockDomain.Addr.t + | Multithreaded +[@@deriving eq, ord, hash] + +let name_varinfo = function + | Locked (Addr (v, _) as l) -> + let name = + if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo v then + Printf.sprintf "alloc_%s%d" (if v.vid < 0 then "m" else "") (abs v.vid) (* turn minus into valid C name *) + else + LockDomain.Addr.show l (* TODO: valid names with interval offsets, etc *) + in + name ^ "_locked" + | Locked _ -> assert false + | Multithreaded -> "multithreaded" + +let show = name_varinfo + +include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) + +let describe_varinfo _ _ = "" + +let typ = function + | Locked _ -> GoblintCil.intType + | Multithreaded -> GoblintCil.intType + +let initial = function + | Locked _ -> GoblintCil.zero + | Multithreaded -> GoblintCil.zero From b04af51f2d86bb20d7908a72948fd97275fdce14 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 19 Apr 2024 13:58:55 +0300 Subject: [PATCH 042/157] Refactor GhostVarAvailable query --- src/analyses/base.ml | 5 +++-- src/analyses/basePriv.ml | 10 ++++++---- src/analyses/mutexGhosts.ml | 3 +-- src/domains/queries.ml | 12 ++++++------ 4 files changed, 16 insertions(+), 14 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index ac31e29163..c1001f8b80 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1247,9 +1247,10 @@ struct if get_bool "exp.earlyglobs" then inv else ( - let var = WitnessGhost.to_varinfo Multithreaded in - if ctx.ask (GhostVarAvailable var) then + if ctx.ask (GhostVarAvailable Multithreaded) then ( + let var = WitnessGhost.to_varinfo Multithreaded in Invariant.(of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) else Invariant.none ) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 129d0d5d69..7a667c9c43 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -342,9 +342,10 @@ struct acc ) cpa Invariant.none in - let var = WitnessGhost.to_varinfo (Locked m') in - if ask.f (GhostVarAvailable var) then + if ask.f (GhostVarAvailable (Locked m')) then ( + let var = WitnessGhost.to_varinfo (Locked m') in Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) else Invariant.none | g -> (* global *) @@ -861,9 +862,10 @@ struct else ( let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) Q.AD.fold (fun m acc -> - let var = WitnessGhost.to_varinfo (Locked m) in - if ask.f (GhostVarAvailable var) then + if ask.f (GhostVarAvailable (Locked m)) then ( + let var = WitnessGhost.to_varinfo (Locked m) in Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) else Invariant.none ) locks inv diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 21a12db7a1..5ffdac6110 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -82,8 +82,7 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | GhostVarAvailable vi -> - GobOption.exists (ghost_var_available ctx) (WitnessGhost.from_varinfo vi) + | GhostVarAvailable v -> ghost_var_available ctx v | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in begin match g with diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 9a50af1907..44a0402a93 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -130,7 +130,7 @@ type _ t = | TmpSpecial: Mval.Exp.t -> ML.t t | MaySignedOverflow: exp -> MayBool.t t | YamlEntryGlobal: Obj.t * YamlWitnessType.Task.t -> YS.t t - | GhostVarAvailable: varinfo -> MustBool.t t + | GhostVarAvailable: WitnessGhostVar.t -> MayBool.t t type 'a result = 'a @@ -203,7 +203,7 @@ struct | TmpSpecial _ -> (module ML) | MaySignedOverflow _ -> (module MayBool) | YamlEntryGlobal _ -> (module YS) - | GhostVarAvailable _ -> (module MustBool) + | GhostVarAvailable _ -> (module MayBool) (** Get bottom result for query. *) let bot (type a) (q: a t): a result = @@ -275,7 +275,7 @@ struct | TmpSpecial _ -> ML.top () | MaySignedOverflow _ -> MayBool.top () | YamlEntryGlobal _ -> YS.top () - | GhostVarAvailable _ -> MustBool.top () + | GhostVarAvailable _ -> MayBool.top () end (* The type any_query can't be directly defined in Any as t, @@ -401,7 +401,7 @@ struct | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 | Any (TmpSpecial lv1), Any (TmpSpecial lv2) -> Mval.Exp.compare lv1 lv2 | Any (MaySignedOverflow e1), Any (MaySignedOverflow e2) -> CilType.Exp.compare e1 e2 - | Any (GhostVarAvailable vi1), Any (GhostVarAvailable vi2) -> CilType.Varinfo.compare vi1 vi2 + | Any (GhostVarAvailable v1), Any (GhostVarAvailable v2) -> WitnessGhostVar.compare v1 v2 (* only argumentless queries should remain *) | _, _ -> Stdlib.compare (order a) (order b) @@ -446,7 +446,7 @@ struct | Any (MustBeSingleThreaded {since_start}) -> Hashtbl.hash since_start | Any (TmpSpecial lv) -> Mval.Exp.hash lv | Any (MaySignedOverflow e) -> CilType.Exp.hash e - | Any (GhostVarAvailable vi) -> CilType.Varinfo.hash vi + | Any (GhostVarAvailable v) -> WitnessGhostVar.hash v (* IterSysVars: *) (* - argument is a function and functions cannot be compared in any meaningful way. *) (* - doesn't matter because IterSysVars is always queried from outside of the analysis, so MCP's query caching is not done for it. *) @@ -512,7 +512,7 @@ struct | Any IsEverMultiThreaded -> Pretty.dprintf "IsEverMultiThreaded" | Any (TmpSpecial lv) -> Pretty.dprintf "TmpSpecial %a" Mval.Exp.pretty lv | Any (MaySignedOverflow e) -> Pretty.dprintf "MaySignedOverflow %a" CilType.Exp.pretty e - | Any (GhostVarAvailable vi) -> Pretty.dprintf "GhostVarAvailable %a" CilType.Varinfo.pretty vi + | Any (GhostVarAvailable v) -> Pretty.dprintf "GhostVarAvailable %a" WitnessGhostVar.pretty v end let to_value_domain_ask (ask: ask) = From d8bd13d7a6770e75fc14958a69510b964bdc4937 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 19 Apr 2024 16:23:05 +0300 Subject: [PATCH 043/157] Exclude WitnessGhostVar from docs check --- scripts/goblint-lib-modules.py | 1 + 1 file changed, 1 insertion(+) diff --git a/scripts/goblint-lib-modules.py b/scripts/goblint-lib-modules.py index 017530f838..98b8acd39f 100755 --- a/scripts/goblint-lib-modules.py +++ b/scripts/goblint-lib-modules.py @@ -44,6 +44,7 @@ "MessageCategory", # included in Messages "PreValueDomain", # included in ValueDomain + "WitnessGhostVar", # included in WitnessGhost "ConfigVersion", "ConfigProfile", From 947d6bc4382c36778c5f6de2d07b07be9637a7ab Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 Apr 2024 12:51:14 +0300 Subject: [PATCH 044/157] Fix __VERIFIER_atomic special mutex ghost varialbe name --- src/witness/witnessGhostVar.ml | 5 +- tests/regression/29-svcomp/16-atomic_priv.t | 88 +++++++++++++++++++++ 2 files changed, 92 insertions(+), 1 deletion(-) create mode 100644 tests/regression/29-svcomp/16-atomic_priv.t diff --git a/src/witness/witnessGhostVar.ml b/src/witness/witnessGhostVar.ml index afcf5d4dba..bc0f98f915 100644 --- a/src/witness/witnessGhostVar.ml +++ b/src/witness/witnessGhostVar.ml @@ -8,10 +8,13 @@ type t = let name_varinfo = function | Locked (Addr (v, _) as l) -> let name = + if CilType.Varinfo.equal v LibraryFunctions.verifier_atomic_var then + "__VERIFIER_atomic" + else if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo v then Printf.sprintf "alloc_%s%d" (if v.vid < 0 then "m" else "") (abs v.vid) (* turn minus into valid C name *) else - LockDomain.Addr.show l (* TODO: valid names with interval offsets, etc *) + LockDomain.Addr.show l (* TODO: valid names with fields, interval offsets, etc *) in name ^ "_locked" | Locked _ -> assert false diff --git a/tests/regression/29-svcomp/16-atomic_priv.t b/tests/regression/29-svcomp/16-atomic_priv.t new file mode 100644 index 0000000000..98584b96d0 --- /dev/null +++ b/tests/regression/29-svcomp/16-atomic_priv.t @@ -0,0 +1,88 @@ + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection-atomic --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 16-atomic_priv.c + [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) + [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) + [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) + [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:24:3-24:33) + [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:26:3-26:33) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 17 + dead: 0 + total lines: 17 + [Warning][Race] Memory location myglobal (race with conf. 110): (16-atomic_priv.c:8:5-8:17) + write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:13:3-13:13) + write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:15:3-15:13) + read with [mhp:{created={[main, t_fun@16-atomic_priv.c:23:3-23:40]}}, thread:[main]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:24:3-24:33) + [Info][Witness] witness generation summary: + total generation entries: 9 + [Info][Race] Memory locations race summary: + safe: 0 + vulnerable: 0 + unsafe: 1 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "1" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 25 + column: 3 + function: main + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "1" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 11 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "0" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 27 + column: 3 + function: main + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "0" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: __VERIFIER_atomic_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || myglobal == 5' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (__VERIFIER_atomic_locked || myglobal == 5)' + type: assertion + format: C From 4ada6eb2ced86b2021bde12937a237d716b6daa4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 Apr 2024 12:55:56 +0300 Subject: [PATCH 045/157] Avoid emitting useless protected invariants from protection privatization --- src/analyses/basePriv.ml | 2 ++ tests/regression/29-svcomp/16-atomic_priv.t | 7 +------ tests/regression/56-witness/64-ghost-multiple-protecting.t | 7 +------ 3 files changed, 4 insertions(+), 12 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 7a667c9c43..7cadf637ad 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -859,6 +859,8 @@ struct let locks = ask.f (Q.MustProtectingLocks g') in if Q.AD.is_top locks || Q.AD.is_empty locks then Invariant.none + else if VD.equal (getg (V.protected g')) (getg (V.unprotected g')) then + Invariant.none (* don't output protected invariant because it's the same as unprotected *) else ( let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) Q.AD.fold (fun m acc -> diff --git a/tests/regression/29-svcomp/16-atomic_priv.t b/tests/regression/29-svcomp/16-atomic_priv.t index 98584b96d0..15425f68dd 100644 --- a/tests/regression/29-svcomp/16-atomic_priv.t +++ b/tests/regression/29-svcomp/16-atomic_priv.t @@ -13,7 +13,7 @@ write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:15:3-15:13) read with [mhp:{created={[main, t_fun@16-atomic_priv.c:23:3-23:40]}}, thread:[main]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:24:3-24:33) [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 8 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 @@ -81,8 +81,3 @@ string: '! multithreaded || myglobal == 5' type: assertion format: C - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (__VERIFIER_atomic_locked || myglobal == 5)' - type: assertion - format: C diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t index d51db2285e..53323355c5 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.t +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -4,7 +4,7 @@ dead: 0 total lines: 19 [Info][Witness] witness generation summary: - total generation entries: 18 + total generation entries: 17 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -133,11 +133,6 @@ protection doesn't have precise protected invariant for g2. string: '! multithreaded || (m2_locked || (m1_locked || g1 == 0))' type: assertion format: C - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (m2_locked || (m1_locked || (0 <= g2 && g2 <= 1)))' - type: assertion - format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= g2 && g2 <= 1)' From a7d43a938181ca404666147d2fc705c09a0fa8e4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 Apr 2024 13:04:26 +0300 Subject: [PATCH 046/157] Avoid useless work in mutex-meet invariant_global if ghost variable isn't available --- src/analyses/basePriv.ml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 7cadf637ad..799290c4fe 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -333,16 +333,16 @@ struct let invariant_global (ask: Q.ask) getg = function | `Left m' as m -> (* mutex *) - let cpa = getg m in - let inv = CPA.fold (fun v _ acc -> - if ask.f (MustBeProtectedBy {mutex = m'; global = v; write = true; protection = Strong}) then - let inv = ValueDomain.invariant_global (fun g -> CPA.find g cpa) v in - Invariant.(acc && inv) - else - acc - ) cpa Invariant.none - in if ask.f (GhostVarAvailable (Locked m')) then ( + let cpa = getg m in + let inv = CPA.fold (fun v _ acc -> + if ask.f (MustBeProtectedBy {mutex = m'; global = v; write = true; protection = Strong}) then + let inv = ValueDomain.invariant_global (fun g -> CPA.find g cpa) v in + Invariant.(acc && inv) + else + acc + ) cpa Invariant.none + in let var = WitnessGhost.to_varinfo (Locked m') in Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) From d6abc0b4f14dccbd1c500ce3a9e23f72497aa966 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 Apr 2024 13:44:29 +0300 Subject: [PATCH 047/157] Fix struct field mutex ghost variable name --- src/witness/witnessGhostVar.ml | 11 ++- tests/regression/13-privatized/25-struct_nr.t | 83 +++++++++++++++++++ 2 files changed, 91 insertions(+), 3 deletions(-) create mode 100644 tests/regression/13-privatized/25-struct_nr.t diff --git a/src/witness/witnessGhostVar.ml b/src/witness/witnessGhostVar.ml index bc0f98f915..cac48050de 100644 --- a/src/witness/witnessGhostVar.ml +++ b/src/witness/witnessGhostVar.ml @@ -6,7 +6,7 @@ type t = [@@deriving eq, ord, hash] let name_varinfo = function - | Locked (Addr (v, _) as l) -> + | Locked (Addr (v, os)) -> let name = if CilType.Varinfo.equal v LibraryFunctions.verifier_atomic_var then "__VERIFIER_atomic" @@ -14,9 +14,14 @@ let name_varinfo = function if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo v then Printf.sprintf "alloc_%s%d" (if v.vid < 0 then "m" else "") (abs v.vid) (* turn minus into valid C name *) else - LockDomain.Addr.show l (* TODO: valid names with fields, interval offsets, etc *) + Basetype.Variables.show v in - name ^ "_locked" + let rec offs: LockDomain.Addr.Offs.t -> string = function + | `NoOffset -> "" + | `Field (f, os') -> "_" ^ f.fname ^ offs os' + | `Index (i, os') -> failwith "TODO" (* TODO: valid names with interval offsets, etc *) + in + name ^ offs os ^ "_locked" | Locked _ -> assert false | Multithreaded -> "multithreaded" diff --git a/tests/regression/13-privatized/25-struct_nr.t b/tests/regression/13-privatized/25-struct_nr.t new file mode 100644 index 0000000000..f3ebcd1c52 --- /dev/null +++ b/tests/regression/13-privatized/25-struct_nr.t @@ -0,0 +1,83 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 25-struct_nr.c + [Success][Assert] Assertion "glob1 == 5" will succeed (25-struct_nr.c:26:3-26:30) + [Success][Assert] Assertion "t == 5" will succeed (25-struct_nr.c:16:3-16:26) + [Success][Assert] Assertion "glob1 == -10" will succeed (25-struct_nr.c:18:3-18:32) + [Success][Assert] Assertion "glob1 == 6" will succeed (25-struct_nr.c:30:3-30:30) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 19 + dead: 0 + total lines: 19 + [Info][Witness] witness generation summary: + total generation entries: 9 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 27 + column: 3 + function: main + - entry_type: ghost_update + variable: lock1_mutex_locked + expression: "1" + location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + - entry_type: ghost_update + variable: lock1_mutex_locked + expression: "1" + location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: lock1_mutex_locked + expression: "0" + location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 32 + column: 3 + function: main + - entry_type: ghost_update + variable: lock1_mutex_locked + expression: "0" + location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: lock1_mutex_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (lock1_mutex_locked || glob1 == 5)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || ((-128 <= glob1 && glob1 <= 127) && glob1 != 0)' + type: assertion + format: C From 6db1d04eeb551a5726bb373e7cc6e6e0394a4368 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 Apr 2024 14:34:05 +0300 Subject: [PATCH 048/157] Fix definite array index mutex ghost variable name --- src/witness/witnessGhostVar.ml | 5 +- tests/regression/13-privatized/80-idx_priv.c | 26 +++++++ tests/regression/13-privatized/80-idx_priv.t | 80 ++++++++++++++++++++ 3 files changed, 110 insertions(+), 1 deletion(-) create mode 100644 tests/regression/13-privatized/80-idx_priv.c create mode 100644 tests/regression/13-privatized/80-idx_priv.t diff --git a/src/witness/witnessGhostVar.ml b/src/witness/witnessGhostVar.ml index cac48050de..cec61b0e2d 100644 --- a/src/witness/witnessGhostVar.ml +++ b/src/witness/witnessGhostVar.ml @@ -19,7 +19,10 @@ let name_varinfo = function let rec offs: LockDomain.Addr.Offs.t -> string = function | `NoOffset -> "" | `Field (f, os') -> "_" ^ f.fname ^ offs os' - | `Index (i, os') -> failwith "TODO" (* TODO: valid names with interval offsets, etc *) + | `Index (i, os') -> + match ValueDomain.ID.to_int i with + | Some i -> assert Z.Compare.(i >= Z.zero); "_" ^ Z.to_string i + | _ -> assert false (* must locksets cannot have ambiguous indices *) in name ^ offs os ^ "_locked" | Locked _ -> assert false diff --git a/tests/regression/13-privatized/80-idx_priv.c b/tests/regression/13-privatized/80-idx_priv.c new file mode 100644 index 0000000000..ed0e8d3228 --- /dev/null +++ b/tests/regression/13-privatized/80-idx_priv.c @@ -0,0 +1,26 @@ +#include +#include + +int data; +pthread_mutex_t m[10]; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m[4]); + data++; // NORACE + data--; // NORACE + pthread_mutex_unlock(&m[4]); + return NULL; +} + +int main() { + for (int i = 0; i < 10; i++) + pthread_mutex_init(&m[i], NULL); + + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + pthread_mutex_lock(&m[4]); + __goblint_check(data == 0); // NORACE + pthread_mutex_unlock(&m[4]); + return 0; +} + diff --git a/tests/regression/13-privatized/80-idx_priv.t b/tests/regression/13-privatized/80-idx_priv.t new file mode 100644 index 0000000000..698744924c --- /dev/null +++ b/tests/regression/13-privatized/80-idx_priv.t @@ -0,0 +1,80 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 80-idx_priv.c + [Success][Assert] Assertion "data == 0" will succeed (80-idx_priv.c:22:3-22:29) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 0 + total lines: 14 + [Info][Witness] witness generation summary: + total generation entries: 9 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 80-idx_priv.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: main + - entry_type: ghost_update + variable: m_4_locked + expression: "1" + location: + file_name: 80-idx_priv.c + file_hash: $FILE_HASH + line: 21 + column: 3 + function: main + - entry_type: ghost_update + variable: m_4_locked + expression: "1" + location: + file_name: 80-idx_priv.c + file_hash: $FILE_HASH + line: 8 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m_4_locked + expression: "0" + location: + file_name: 80-idx_priv.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + - entry_type: ghost_update + variable: m_4_locked + expression: "0" + location: + file_name: 80-idx_priv.c + file_hash: $FILE_HASH + line: 11 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m_4_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m_4_locked || data == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= data && data <= 1)' + type: assertion + format: C From 53a714fe979757f8f71c1ea408f3a3e5ccd4120c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 Apr 2024 15:28:26 +0300 Subject: [PATCH 049/157] Make non-definite ghost variables unavailable --- src/analyses/mutexGhosts.ml | 2 +- .../56-witness/68-ghost-ambiguous-idx.c | 28 +++++++ .../56-witness/68-ghost-ambiguous-idx.t | 78 +++++++++++++++++++ 3 files changed, 107 insertions(+), 1 deletion(-) create mode 100644 tests/regression/56-witness/68-ghost-ambiguous-idx.c create mode 100644 tests/regression/56-witness/68-ghost-ambiguous-idx.t diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 5ffdac6110..128355e919 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -77,7 +77,7 @@ struct ctx.local let ghost_var_available ctx = function - | WitnessGhost.Var.Locked lock -> not (G.lock (ctx.global (V.lock lock)): bool) + | WitnessGhost.Var.Locked lock -> LockDomain.Addr.is_definite lock && not (G.lock (ctx.global (V.lock lock))) | Multithreaded -> true let query ctx (type a) (q: a Queries.t): a Queries.result = diff --git a/tests/regression/56-witness/68-ghost-ambiguous-idx.c b/tests/regression/56-witness/68-ghost-ambiguous-idx.c new file mode 100644 index 0000000000..7babbe003c --- /dev/null +++ b/tests/regression/56-witness/68-ghost-ambiguous-idx.c @@ -0,0 +1,28 @@ +#include +#include + +int data; +pthread_mutex_t m[10]; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m[4]); + data++; + data--; + pthread_mutex_unlock(&m[4]); + return NULL; +} + +int main() { + for (int i = 0; i < 10; i++) + pthread_mutex_init(&m[i], NULL); + + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + int r; + int j = r ? 4 : 5; + pthread_mutex_lock(&m[r]); + __goblint_check(data == 0); // UNKNOWN! + pthread_mutex_unlock(&m[4]); + return 0; +} + diff --git a/tests/regression/56-witness/68-ghost-ambiguous-idx.t b/tests/regression/56-witness/68-ghost-ambiguous-idx.t new file mode 100644 index 0000000000..0f6191188e --- /dev/null +++ b/tests/regression/56-witness/68-ghost-ambiguous-idx.t @@ -0,0 +1,78 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 68-ghost-ambiguous-idx.c + [Warning][Assert] Assertion "data == 0" is unknown. (68-ghost-ambiguous-idx.c:24:3-24:29) + [Warning][Unknown] unlocking mutex (m[4]) which may not be held (68-ghost-ambiguous-idx.c:25:3-25:30) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 15 + dead: 0 + total lines: 15 + [Warning][Race] Memory location data (race with conf. 110): (68-ghost-ambiguous-idx.c:4:5-4:9) + write with [lock:{m[4]}, thread:[main, t_fun@68-ghost-ambiguous-idx.c:20:3-20:40]] (conf. 110) (exp: & data) (68-ghost-ambiguous-idx.c:9:3-9:9) + write with [lock:{m[4]}, thread:[main, t_fun@68-ghost-ambiguous-idx.c:20:3-20:40]] (conf. 110) (exp: & data) (68-ghost-ambiguous-idx.c:10:3-10:9) + read with [mhp:{created={[main, t_fun@68-ghost-ambiguous-idx.c:20:3-20:40]}}, thread:[main]] (conf. 110) (exp: & data) (68-ghost-ambiguous-idx.c:24:3-24:29) + [Info][Witness] witness generation summary: + total generation entries: 8 + [Info][Race] Memory locations race summary: + safe: 0 + vulnerable: 0 + unsafe: 1 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: main + - entry_type: ghost_update + variable: m_4_locked + expression: "1" + location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 8 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m_4_locked + expression: "0" + location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 25 + column: 3 + function: main + - entry_type: ghost_update + variable: m_4_locked + expression: "0" + location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 11 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m_4_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m_4_locked || data == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= data && data <= 1)' + type: assertion + format: C + +TODO: there shouldn't be invariant with m_4_locked because it's ambiguously used From 413b2e17dd3e4e8b7e53ec50af475eee539d44ee Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 Apr 2024 15:32:59 +0300 Subject: [PATCH 050/157] Disable mutex ghosts with indices --- src/analyses/mutexGhosts.ml | 3 +- tests/regression/13-privatized/80-idx_priv.t | 50 ++----------------- .../56-witness/68-ghost-ambiguous-idx.t | 41 +-------------- 3 files changed, 6 insertions(+), 88 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 128355e919..b7001c6c2f 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -77,7 +77,8 @@ struct ctx.local let ghost_var_available ctx = function - | WitnessGhost.Var.Locked lock -> LockDomain.Addr.is_definite lock && not (G.lock (ctx.global (V.lock lock))) + | WitnessGhost.Var.Locked (Addr (v, o) as lock) -> not (LockDomain.Offs.contains_index o) && not (G.lock (ctx.global (V.lock lock))) + | Locked _ -> false | Multithreaded -> true let query ctx (type a) (q: a Queries.t): a Queries.result = diff --git a/tests/regression/13-privatized/80-idx_priv.t b/tests/regression/13-privatized/80-idx_priv.t index 698744924c..bf15cfb538 100644 --- a/tests/regression/13-privatized/80-idx_priv.t +++ b/tests/regression/13-privatized/80-idx_priv.t @@ -5,7 +5,7 @@ dead: 0 total lines: 14 [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -22,59 +22,15 @@ line: 20 column: 3 function: main - - entry_type: ghost_update - variable: m_4_locked - expression: "1" - location: - file_name: 80-idx_priv.c - file_hash: $FILE_HASH - line: 21 - column: 3 - function: main - - entry_type: ghost_update - variable: m_4_locked - expression: "1" - location: - file_name: 80-idx_priv.c - file_hash: $FILE_HASH - line: 8 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m_4_locked - expression: "0" - location: - file_name: 80-idx_priv.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: main - - entry_type: ghost_update - variable: m_4_locked - expression: "0" - location: - file_name: 80-idx_priv.c - file_hash: $FILE_HASH - line: 11 - column: 3 - function: t_fun - entry_type: ghost_variable variable: multithreaded scope: global type: int initial: "0" - - entry_type: ghost_variable - variable: m_4_locked - scope: global - type: int - initial: "0" - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (m_4_locked || data == 0)' - type: assertion - format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= data && data <= 1)' type: assertion format: C + +TODO: protected invariant with m_4_locked without making 56-witness/68-ghost-ambiguous-idx unsound diff --git a/tests/regression/56-witness/68-ghost-ambiguous-idx.t b/tests/regression/56-witness/68-ghost-ambiguous-idx.t index 0f6191188e..48837fcabb 100644 --- a/tests/regression/56-witness/68-ghost-ambiguous-idx.t +++ b/tests/regression/56-witness/68-ghost-ambiguous-idx.t @@ -10,7 +10,7 @@ write with [lock:{m[4]}, thread:[main, t_fun@68-ghost-ambiguous-idx.c:20:3-20:40]] (conf. 110) (exp: & data) (68-ghost-ambiguous-idx.c:10:3-10:9) read with [mhp:{created={[main, t_fun@68-ghost-ambiguous-idx.c:20:3-20:40]}}, thread:[main]] (conf. 110) (exp: & data) (68-ghost-ambiguous-idx.c:24:3-24:29) [Info][Witness] witness generation summary: - total generation entries: 8 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 @@ -27,52 +27,13 @@ line: 20 column: 3 function: main - - entry_type: ghost_update - variable: m_4_locked - expression: "1" - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 8 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m_4_locked - expression: "0" - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 25 - column: 3 - function: main - - entry_type: ghost_update - variable: m_4_locked - expression: "0" - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 11 - column: 3 - function: t_fun - entry_type: ghost_variable variable: multithreaded scope: global type: int initial: "0" - - entry_type: ghost_variable - variable: m_4_locked - scope: global - type: int - initial: "0" - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (m_4_locked || data == 0)' - type: assertion - format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= data && data <= 1)' type: assertion format: C - -TODO: there shouldn't be invariant with m_4_locked because it's ambiguously used From ea849fbb840452090517c6395c78fbffd5226ea4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Apr 2024 10:28:28 +0300 Subject: [PATCH 051/157] Detect thread create nodes in mutexGhosts --- src/analyses/mutexGhosts.ml | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index b7001c6c2f..803f80f3e6 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -33,11 +33,16 @@ struct include BoolDomain.MayBool let name () = "multithread" end + module ThreadCreate = + struct + include BoolDomain.MayBool + let name () = "threadcreate" + end module G = struct - include Lattice.Lift2 (Lattice.Prod3 (Locked) (Unlocked) (MultiThread)) (BoolDomain.MayBool) + include Lattice.Lift2 (Lattice.Prod4 (Locked) (Unlocked) (MultiThread) (ThreadCreate)) (BoolDomain.MayBool) let node = function - | `Bot -> (Locked.bot (), Unlocked.bot (), MultiThread.bot ()) + | `Bot -> (Locked.bot (), Unlocked.bot (), MultiThread.bot (), ThreadCreate.bot ()) | `Lifted1 x -> x | _ -> failwith "MutexGhosts.node" let lock = function @@ -51,9 +56,9 @@ struct let event ctx e octx = begin match e with | Events.Lock (l, _) -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ())); + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot (), ThreadCreate.bot ())); if !AnalysisState.postsolving then ( - let (locked, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in + let (locked, _, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in if Locked.cardinal locked > 1 then ( Locked.iter (fun lock -> ctx.sideg (V.lock lock) (G.create_lock true) @@ -61,9 +66,9 @@ struct ); ) | Events.Unlock l -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ())); + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot (), ThreadCreate.bot ())); if !AnalysisState.postsolving then ( - let (_, unlocked, _) = G.node (ctx.global (V.node ctx.prev_node)) in + let (_, unlocked, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in if Locked.cardinal unlocked > 1 then ( Locked.iter (fun lock -> ctx.sideg (V.lock lock) (G.create_lock true) @@ -71,11 +76,15 @@ struct ); ) | Events.EnterMultiThreaded -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true)) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true, ThreadCreate.bot ())) | _ -> () end; ctx.local + let threadspawn ctx ~multiple lval f args octx = + ctx.sideg (V.node ctx.node) (G.create_node (Locked.bot (), Unlocked.bot (), MultiThread.bot (), true)); + ctx.local + let ghost_var_available ctx = function | WitnessGhost.Var.Locked (Addr (v, o) as lock) -> not (LockDomain.Offs.contains_index o) && not (G.lock (ctx.global (V.lock lock))) | Locked _ -> false @@ -88,7 +97,7 @@ struct let g: V.t = Obj.obj g in begin match g with | `Left g' -> - let (locked, unlocked, multithread) = G.node (ctx.global g) in + let (locked, unlocked, multithread, threadcreate) = G.node (ctx.global g) in let g = g' in let entries = (* TODO: do variable_entry-s only once *) From 594beaceed70cb0e85ed0b56c9c26711becc1956 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Apr 2024 10:44:00 +0300 Subject: [PATCH 052/157] Refactor mutexGhosts thread creation collection --- src/analyses/mutexGhosts.ml | 44 +++++++++++++++++++++---------------- src/domains/queries.ml | 1 + 2 files changed, 26 insertions(+), 19 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 803f80f3e6..9ddde5d37e 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -2,20 +2,25 @@ open Analyses +module NodeSet = Queries.NS + module Spec = struct include UnitAnalysis.Spec let name () = "mutexGhosts" + module ThreadCreate = Printable.UnitConf (struct let name = "threadcreate" end) module V = struct - include Printable.Either (Node) (LockDomain.Addr) + include Printable.Either3 (Node) (LockDomain.Addr) (ThreadCreate) let node x = `Left x - let lock x = `Right x + let lock x = `Middle x + let threadcreate = `Right () let is_write_only = function | `Left _ -> false - | `Right _ -> true + | `Middle _ -> true + | `Right _ -> false end module Locked = @@ -33,32 +38,32 @@ struct include BoolDomain.MayBool let name () = "multithread" end - module ThreadCreate = - struct - include BoolDomain.MayBool - let name () = "threadcreate" - end module G = struct - include Lattice.Lift2 (Lattice.Prod4 (Locked) (Unlocked) (MultiThread) (ThreadCreate)) (BoolDomain.MayBool) + include Lattice.Lift2 (Lattice.Prod3 (Locked) (Unlocked) (MultiThread)) (Lattice.Lift2 (BoolDomain.MayBool) (NodeSet)) let node = function - | `Bot -> (Locked.bot (), Unlocked.bot (), MultiThread.bot (), ThreadCreate.bot ()) + | `Bot -> (Locked.bot (), Unlocked.bot (), MultiThread.bot ()) | `Lifted1 x -> x | _ -> failwith "MutexGhosts.node" let lock = function | `Bot -> BoolDomain.MayBool.bot () - | `Lifted2 x -> x + | `Lifted2 (`Lifted1 x) -> x | _ -> failwith "MutexGhosts.lock" + let threadcreate = function + | `Bot -> NodeSet.bot () + | `Lifted2 (`Lifted2 x) -> x + | _ -> failwith "MutexGhosts.threadcreate" let create_node node = `Lifted1 node - let create_lock lock = `Lifted2 lock + let create_lock lock = `Lifted2 (`Lifted1 lock) + let create_threadcreate threadcreate = `Lifted2 (`Lifted2 threadcreate) end let event ctx e octx = begin match e with | Events.Lock (l, _) -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot (), ThreadCreate.bot ())); + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ())); if !AnalysisState.postsolving then ( - let (locked, _, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in + let (locked, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in if Locked.cardinal locked > 1 then ( Locked.iter (fun lock -> ctx.sideg (V.lock lock) (G.create_lock true) @@ -66,9 +71,9 @@ struct ); ) | Events.Unlock l -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot (), ThreadCreate.bot ())); + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ())); if !AnalysisState.postsolving then ( - let (_, unlocked, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in + let (_, unlocked, _) = G.node (ctx.global (V.node ctx.prev_node)) in if Locked.cardinal unlocked > 1 then ( Locked.iter (fun lock -> ctx.sideg (V.lock lock) (G.create_lock true) @@ -76,13 +81,13 @@ struct ); ) | Events.EnterMultiThreaded -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true, ThreadCreate.bot ())) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true)) | _ -> () end; ctx.local let threadspawn ctx ~multiple lval f args octx = - ctx.sideg (V.node ctx.node) (G.create_node (Locked.bot (), Unlocked.bot (), MultiThread.bot (), true)); + ctx.sideg V.threadcreate (G.create_threadcreate (NodeSet.singleton ctx.node)); ctx.local let ghost_var_available ctx = function @@ -97,7 +102,7 @@ struct let g: V.t = Obj.obj g in begin match g with | `Left g' -> - let (locked, unlocked, multithread, threadcreate) = G.node (ctx.global g) in + let (locked, unlocked, multithread) = G.node (ctx.global g) in let g = g' in let entries = (* TODO: do variable_entry-s only once *) @@ -144,6 +149,7 @@ struct entries in entries + | `Middle _ -> Queries.Result.top q | `Right _ -> Queries.Result.top q end | _ -> Queries.Result.top q diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 44a0402a93..515198854d 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -10,6 +10,7 @@ module LS = VDQ.LS module TS = SetDomain.ToppedSet (CilType.Typ) (struct let topname = "All" end) module ES = SetDomain.Reverse (SetDomain.ToppedSet (CilType.Exp) (struct let topname = "All" end)) module VS = SetDomain.ToppedSet (CilType.Varinfo) (struct let topname = "All" end) +module NS = SetDomain.ToppedSet (Node) (struct let topname = "All" end) module NFL = WrapperFunctionAnalysis0.NodeFlatLattice module TC = WrapperFunctionAnalysis0.ThreadCreateUniqueCount From 584b78842a0a38fee98c73d59629a707218b0e0a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Apr 2024 11:06:39 +0300 Subject: [PATCH 053/157] Add option to emit flow_insensitive_invariant-s as location_invariant-s --- src/analyses/mutexGhosts.ml | 1 + src/config/options.schema.json | 6 +++ src/domains/queries.ml | 5 +++ src/witness/yamlWitness.ml | 21 ++++++++-- tests/regression/13-privatized/74-mutex.t | 50 ++++++++++++++++++++++- 5 files changed, 79 insertions(+), 4 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 9ddde5d37e..75195e4662 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -152,6 +152,7 @@ struct | `Middle _ -> Queries.Result.top q | `Right _ -> Queries.Result.top q end + | InvariantGlobalNodes -> (G.threadcreate (ctx.global V.threadcreate): NodeSet.t) | _ -> Queries.Result.top q end diff --git a/src/config/options.schema.json b/src/config/options.schema.json index db93e74ff4..3065325f4e 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -2493,6 +2493,12 @@ "description": "Emit invariants with typedef-ed types (e.g. in casts). Our validator cannot parse these.", "type": "boolean", "default": true + }, + "flow_insensitive-as-location": { + "title": "witness.invariant.flow_insensitive-as-location", + "description": "Emit flow-insensitive invariants as location invariants at certain locations.", + "type": "boolean", + "default": false } }, "additionalProperties": false diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 515198854d..152fb5f1a5 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -132,6 +132,7 @@ type _ t = | MaySignedOverflow: exp -> MayBool.t t | YamlEntryGlobal: Obj.t * YamlWitnessType.Task.t -> YS.t t | GhostVarAvailable: WitnessGhostVar.t -> MayBool.t t + | InvariantGlobalNodes: NS.t t (* TODO: V.t argument? *) type 'a result = 'a @@ -205,6 +206,7 @@ struct | MaySignedOverflow _ -> (module MayBool) | YamlEntryGlobal _ -> (module YS) | GhostVarAvailable _ -> (module MayBool) + | InvariantGlobalNodes -> (module NS) (** Get bottom result for query. *) let bot (type a) (q: a t): a result = @@ -277,6 +279,7 @@ struct | MaySignedOverflow _ -> MayBool.top () | YamlEntryGlobal _ -> YS.top () | GhostVarAvailable _ -> MayBool.top () + | InvariantGlobalNodes -> NS.top () end (* The type any_query can't be directly defined in Any as t, @@ -346,6 +349,7 @@ struct | Any (YamlEntryGlobal _) -> 59 | Any (MustProtectingLocks _) -> 60 | Any (GhostVarAvailable _) -> 61 + | Any InvariantGlobalNodes -> 62 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -514,6 +518,7 @@ struct | Any (TmpSpecial lv) -> Pretty.dprintf "TmpSpecial %a" Mval.Exp.pretty lv | Any (MaySignedOverflow e) -> Pretty.dprintf "MaySignedOverflow %a" CilType.Exp.pretty e | Any (GhostVarAvailable v) -> Pretty.dprintf "GhostVarAvailable %a" WitnessGhostVar.pretty v + | Any InvariantGlobalNodes -> Pretty.dprintf "InvariantGlobalNodes" end let to_value_domain_ask (ask: ask) = diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 9eafae009f..49fe889c22 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -325,18 +325,33 @@ struct (* Generate flow-insensitive invariants *) let entries = if entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type then ( + let ns = R.ask_global InvariantGlobalNodes in GHT.fold (fun g v acc -> match g with | `Left g -> (* Spec global *) - begin match R.ask_global (InvariantGlobal (Obj.repr g)) with - | `Lifted inv -> + begin match R.ask_global (InvariantGlobal (Obj.repr g)), GobConfig.get_bool "witness.invariant.flow_insensitive-as-location" with + | `Lifted inv, false -> let invs = WitnessUtil.InvariantExp.process_exp inv in List.fold_left (fun acc inv -> let invariant = Entry.invariant (CilType.Exp.show inv) in let entry = Entry.flow_insensitive_invariant ~task ~invariant in entry :: acc ) acc invs - | `Bot | `Top -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) + | `Lifted inv, true -> + (* TODO: or do at location_invariant loop for each node and query if should also do global invariants there? *) + let invs = WitnessUtil.InvariantExp.process_exp inv in + Queries.NS.fold (fun n acc -> + let fundec = Node.find_fundec n in + let loc = Node.location n in + let location_function = fundec.svar.vname in + let location = Entry.location ~location:loc ~location_function in + List.fold_left (fun acc inv -> + let invariant = Entry.invariant (CilType.Exp.show inv) in + let entry = Entry.location_invariant ~task ~location ~invariant in + entry :: acc + ) acc invs + ) ns acc + | `Bot, _ | `Top, _ -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc end | `Right _ -> (* contexts global *) diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 6f84aa184f..a00f49eb1a 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -15,7 +15,7 @@ unsafe: 0 total memory locations: 1 - $ yamlWitnessStrip < witness.yml + $ yamlWitnessStrip < witness.yml | tee witness.flow_insensitive.yml - entry_type: ghost_update variable: multithreaded expression: "1" @@ -82,6 +82,54 @@ type: assertion format: C +Flow-insensitive invariants as location invariants. + + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' --enable witness.invariant.flow_insensitive-as-location 74-mutex.c + [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) + [Warning][Deadcode] Function 'producer' has dead code: + on line 26 (74-mutex.c:26-26) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 15 + dead: 1 + total lines: 16 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Witness] witness generation summary: + total generation entries: 9 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml > witness.location.yml + + $ diff witness.flow_insensitive.yml witness.location.yml + 56,57c56,63 + < - entry_type: flow_insensitive_invariant + < flow_insensitive_invariant: + --- + > - entry_type: location_invariant + > location: + > file_name: 74-mutex.c + > file_hash: $FILE_HASH + > line: 36 + > column: 3 + > function: main + > location_invariant: + 61,62c67,74 + < - entry_type: flow_insensitive_invariant + < flow_insensitive_invariant: + --- + > - entry_type: location_invariant + > location: + > file_name: 74-mutex.c + > file_hash: $FILE_HASH + > line: 36 + > column: 3 + > function: main + > location_invariant: + [1] + Should also work with earlyglobs. Earlyglobs shouldn't cause protected writes in multithreaded mode from being immediately published to protected invariant. From 8d5cc1275a71283c88cdd3136715da524cec7b51 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 25 Apr 2024 10:13:39 +0300 Subject: [PATCH 054/157] Add svcomp-ghost conf --- conf/svcomp-ghost.json | 145 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 145 insertions(+) create mode 100644 conf/svcomp-ghost.json diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json new file mode 100644 index 0000000000..62feb25993 --- /dev/null +++ b/conf/svcomp-ghost.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", + "var_eq", + "symb_locks", + "region", + "thread", + "threadJoins", + "mutexGhosts", + "pthreadMutexType" + ], + "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": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "flow_insensitive_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": true, + "other": true, + "accessed": true, + "exact": true, + "all-locals": false, + "flow_insensitive-as-location": 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 96d862e4369df5355f80fcc69a94c7e53de806ac Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 25 Apr 2024 10:14:19 +0300 Subject: [PATCH 055/157] Use YAML witness format-version 0.1 for svcomp-ghost --- conf/svcomp-ghost.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json index 62feb25993..229dd9ef46 100644 --- a/conf/svcomp-ghost.json +++ b/conf/svcomp-ghost.json @@ -114,7 +114,7 @@ }, "yaml": { "enabled": true, - "format-version": "2.0", + "format-version": "0.1", "entry-types": [ "flow_insensitive_invariant" ] From 257fa8cd374f4b339427eb4c2c52cf67d72aa298 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 25 Apr 2024 10:24:44 +0300 Subject: [PATCH 056/157] Test witness.invariant.flow_insensitive-as-location with for loop --- .../regression/13-privatized/04-priv_multi.t | 309 ++++++++++++++++++ 1 file changed, 309 insertions(+) create mode 100644 tests/regression/13-privatized/04-priv_multi.t diff --git a/tests/regression/13-privatized/04-priv_multi.t b/tests/regression/13-privatized/04-priv_multi.t new file mode 100644 index 0000000000..9bdf8ac5a7 --- /dev/null +++ b/tests/regression/13-privatized/04-priv_multi.t @@ -0,0 +1,309 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 04-priv_multi.c + [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) + [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) + [Warning][Deadcode] Function 'dispose' has dead code: + on line 53 (04-priv_multi.c:53-53) + on line 56 (04-priv_multi.c:56-56) + [Warning][Deadcode] Function 'process' has dead code: + on line 37 (04-priv_multi.c:37-37) + on line 40 (04-priv_multi.c:40-40) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 40 + dead: 4 + total lines: 44 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (04-priv_multi.c:25:10-25:11) + [Warning][Deadcode][CWE-571] condition 'A > 0' is always true (04-priv_multi.c:27:9-27:14) + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (04-priv_multi.c:45:10-45:11) + [Warning][Deadcode][CWE-571] condition 'B > 0' is always true (04-priv_multi.c:47:9-47:14) + [Info][Witness] witness generation summary: + total generation entries: 19 + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 0 + total memory locations: 2 + + $ yamlWitnessStrip < witness.yml | tee witness.flow_insensitive.yml + - entry_type: ghost_update + variable: mutex_B_locked + expression: "1" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 69 + column: 5 + function: main + - entry_type: ghost_update + variable: mutex_B_locked + expression: "1" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 46 + column: 5 + function: dispose + - entry_type: ghost_update + variable: mutex_B_locked + expression: "1" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 29 + column: 7 + function: process + - entry_type: ghost_update + variable: mutex_B_locked + expression: "0" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 73 + column: 5 + function: main + - entry_type: ghost_update + variable: mutex_B_locked + expression: "0" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 49 + column: 7 + function: dispose + - entry_type: ghost_update + variable: mutex_B_locked + expression: "0" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 32 + column: 7 + function: process + - entry_type: ghost_update + variable: mutex_A_locked + expression: "1" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 68 + column: 5 + function: main + - entry_type: ghost_update + variable: mutex_A_locked + expression: "1" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 26 + column: 5 + function: process + - entry_type: ghost_update + variable: mutex_A_locked + expression: "1" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 15 + column: 5 + function: generate + - entry_type: ghost_update + variable: mutex_A_locked + expression: "0" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 74 + column: 5 + function: main + - entry_type: ghost_update + variable: mutex_A_locked + expression: "0" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 34 + column: 7 + function: process + - entry_type: ghost_update + variable: mutex_A_locked + expression: "0" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 18 + column: 5 + function: generate + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 63 + column: 3 + function: main + - entry_type: ghost_variable + variable: mutex_B_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: mutex_A_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (mutex_B_locked || (mutex_A_locked || B == 5))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (mutex_A_locked || A == 5)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || ((0 <= B && B <= 127) && B != 0)' + type: assertion + format: C + +Flow-insensitive invariants as location invariants. + + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' --enable witness.invariant.flow_insensitive-as-location 04-priv_multi.c + [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) + [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) + [Warning][Deadcode] Function 'dispose' has dead code: + on line 53 (04-priv_multi.c:53-53) + on line 56 (04-priv_multi.c:56-56) + [Warning][Deadcode] Function 'process' has dead code: + on line 37 (04-priv_multi.c:37-37) + on line 40 (04-priv_multi.c:40-40) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 40 + dead: 4 + total lines: 44 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (04-priv_multi.c:25:10-25:11) + [Warning][Deadcode][CWE-571] condition 'A > 0' is always true (04-priv_multi.c:27:9-27:14) + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (04-priv_multi.c:45:10-45:11) + [Warning][Deadcode][CWE-571] condition 'B > 0' is always true (04-priv_multi.c:47:9-47:14) + [Info][Witness] witness generation summary: + total generation entries: 25 + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 0 + total memory locations: 2 + + $ yamlWitnessStrip < witness.yml > witness.location.yml + +Location invariant at `for` loop in `main` should be on column 3, not 7. + + $ diff witness.flow_insensitive.yml witness.location.yml + 133,134c133,140 + < - entry_type: flow_insensitive_invariant + < flow_insensitive_invariant: + --- + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 67 + > column: 7 + > function: main + > location_invariant: + 138,139c144,151 + < - entry_type: flow_insensitive_invariant + < flow_insensitive_invariant: + --- + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 67 + > column: 7 + > function: main + > location_invariant: + 143,144c155,228 + < - entry_type: flow_insensitive_invariant + < flow_insensitive_invariant: + --- + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 67 + > column: 7 + > function: main + > location_invariant: + > string: '! multithreaded || ((0 <= B && B <= 127) && B != 0)' + > type: assertion + > format: C + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 65 + > column: 3 + > function: main + > location_invariant: + > string: '! multithreaded || (mutex_B_locked || (mutex_A_locked || B == 5))' + > type: assertion + > format: C + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 65 + > column: 3 + > function: main + > location_invariant: + > string: '! multithreaded || (mutex_A_locked || A == 5)' + > type: assertion + > format: C + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 65 + > column: 3 + > function: main + > location_invariant: + > string: '! multithreaded || ((0 <= B && B <= 127) && B != 0)' + > type: assertion + > format: C + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 64 + > column: 3 + > function: main + > location_invariant: + > string: '! multithreaded || (mutex_B_locked || (mutex_A_locked || B == 5))' + > type: assertion + > format: C + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 64 + > column: 3 + > function: main + > location_invariant: + > string: '! multithreaded || (mutex_A_locked || A == 5)' + > type: assertion + > format: C + > - entry_type: location_invariant + > location: + > file_name: 04-priv_multi.c + > file_hash: $FILE_HASH + > line: 64 + > column: 3 + > function: main + > location_invariant: + [1] From 10dfba1437956105d7a5a91c3f3bf410ebbc9b36 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 25 Apr 2024 10:29:53 +0300 Subject: [PATCH 057/157] Fix witness.invariant.flow_insensitive-as-location at loop node --- src/witness/yamlWitness.ml | 18 ++++++++++-------- tests/regression/13-privatized/04-priv_multi.t | 6 +++--- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 49fe889c22..b7bf11a31c 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -342,14 +342,16 @@ struct let invs = WitnessUtil.InvariantExp.process_exp inv in Queries.NS.fold (fun n acc -> let fundec = Node.find_fundec n in - let loc = Node.location n in - let location_function = fundec.svar.vname in - let location = Entry.location ~location:loc ~location_function in - List.fold_left (fun acc inv -> - let invariant = Entry.invariant (CilType.Exp.show inv) in - let entry = Entry.location_invariant ~task ~location ~invariant in - entry :: acc - ) acc invs + match WitnessInvariant.location_location n with (* if after thread create node happens to be loop node *) + | Some loc -> + let location_function = fundec.svar.vname in + let location = Entry.location ~location:loc ~location_function in + List.fold_left (fun acc inv -> + let invariant = Entry.invariant (CilType.Exp.show inv) in + let entry = Entry.location_invariant ~task ~location ~invariant in + entry :: acc + ) acc invs + | None -> acc ) ns acc | `Bot, _ | `Top, _ -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc diff --git a/tests/regression/13-privatized/04-priv_multi.t b/tests/regression/13-privatized/04-priv_multi.t index 9bdf8ac5a7..952696a5c4 100644 --- a/tests/regression/13-privatized/04-priv_multi.t +++ b/tests/regression/13-privatized/04-priv_multi.t @@ -213,7 +213,7 @@ Location invariant at `for` loop in `main` should be on column 3, not 7. > file_name: 04-priv_multi.c > file_hash: $FILE_HASH > line: 67 - > column: 7 + > column: 3 > function: main > location_invariant: 138,139c144,151 @@ -225,7 +225,7 @@ Location invariant at `for` loop in `main` should be on column 3, not 7. > file_name: 04-priv_multi.c > file_hash: $FILE_HASH > line: 67 - > column: 7 + > column: 3 > function: main > location_invariant: 143,144c155,228 @@ -237,7 +237,7 @@ Location invariant at `for` loop in `main` should be on column 3, not 7. > file_name: 04-priv_multi.c > file_hash: $FILE_HASH > line: 67 - > column: 7 + > column: 3 > function: main > location_invariant: > string: '! multithreaded || ((0 <= B && B <= 127) && B != 0)' From 16c97fde01a00b5ae8892bc8de0dea5c1070e298 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 Apr 2024 12:56:37 +0300 Subject: [PATCH 058/157] Add cram test for relational mutex-meet flow-insensitive invariants --- .../regression/36-apron/12-traces-min-rpb1.t | 98 +++++++++++++++++++ tests/regression/36-apron/dune | 3 + 2 files changed, 101 insertions(+) create mode 100644 tests/regression/36-apron/12-traces-min-rpb1.t diff --git a/tests/regression/36-apron/12-traces-min-rpb1.t b/tests/regression/36-apron/12-traces-min-rpb1.t new file mode 100644 index 0000000000..13cefb9557 --- /dev/null +++ b/tests/regression/36-apron/12-traces-min-rpb1.t @@ -0,0 +1,98 @@ + $ goblint --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 12-traces-min-rpb1.c + [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:16:3-16:26) + [Warning][Assert] Assertion "g == h" is unknown. (12-traces-min-rpb1.c:27:3-27:26) + [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:29:3-29:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 18 + dead: 0 + total lines: 18 + [Warning][Race] Memory location h (race with conf. 110): (12-traces-min-rpb1.c:8:5-8:10) + write with [lock:{A}, thread:[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]] (conf. 110) (exp: & h) (12-traces-min-rpb1.c:15:3-15:8) + read with [mhp:{created={[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]}}, thread:[main]] (conf. 110) (exp: & h) (12-traces-min-rpb1.c:27:3-27:26) + [Warning][Race] Memory location g (race with conf. 110): (12-traces-min-rpb1.c:7:5-7:10) + write with [lock:{A}, thread:[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]] (conf. 110) (exp: & g) (12-traces-min-rpb1.c:14:3-14:8) + read with [mhp:{created={[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]}}, thread:[main]] (conf. 110) (exp: & g) (12-traces-min-rpb1.c:27:3-27:26) + [Info][Witness] witness generation summary: + total generation entries: 9 + [Info][Race] Memory locations race summary: + safe: 0 + vulnerable: 0 + unsafe: 2 + total memory locations: 2 + +TODO: emit g == h + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 25 + column: 3 + function: main + - entry_type: ghost_update + variable: A_locked + expression: "1" + location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + - entry_type: ghost_update + variable: A_locked + expression: "1" + location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 18 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: A_locked + expression: "1" + location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: A_locked + expression: "0" + location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 30 + column: 3 + function: main + - entry_type: ghost_update + variable: A_locked + expression: "0" + location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 19 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: A_locked + expression: "0" + location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: A_locked + scope: global + type: int + initial: "0" diff --git a/tests/regression/36-apron/dune b/tests/regression/36-apron/dune index 099ec878b2..b14ebdfe64 100644 --- a/tests/regression/36-apron/dune +++ b/tests/regression/36-apron/dune @@ -8,3 +8,6 @@ (glob_files ??-*.c)) (locks /update_suite) (action (chdir ../../.. (run %{update_suite} group apron)))) + +(cram + (deps (glob_files *.c))) From 5650784effc4c077a7f7efed045c201f42b5748b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 Apr 2024 13:04:36 +0300 Subject: [PATCH 059/157] Add InvariantGlobal interface to relational privatizations --- src/analyses/apron/relationAnalysis.apron.ml | 13 +++++++++++++ src/analyses/apron/relationPriv.apron.ml | 9 +++++++++ 2 files changed, 22 insertions(+) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index f1ea72d0a1..ba5b90525c 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -634,6 +634,16 @@ struct ) |> Enum.fold (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none + let query_invariant_global ctx g = + (* TODO: option? *) + if ctx.ask (GhostVarAvailable Multithreaded) then ( + let var = WitnessGhost.to_varinfo Multithreaded in + let inv = Priv.invariant_global (Analyses.ask_of_ctx ctx) ctx.global g in + Invariant.(of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) + else + Invariant.none + let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in let st = ctx.local in @@ -655,6 +665,9 @@ struct let vf' x = vf (Obj.repr x) in Priv.iter_sys_vars ctx.global vq vf' | Queries.Invariant context -> query_invariant ctx context + | Queries.InvariantGlobal g -> + let g: V.t = Obj.obj g in + query_invariant_global ctx g | _ -> Result.top q diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 66548c117c..f286287dbe 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -46,6 +46,9 @@ module type S = val thread_return: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> ThreadIdDomain.Thread.t -> relation_components_t -> relation_components_t val iter_sys_vars: (V.t -> G.t) -> VarQuery.t -> V.t VarQuery.f -> unit (** [Queries.IterSysVars] for apron. *) + val invariant_global: Q.ask -> (V.t -> G.t) -> V.t -> Invariant.t + (** Returns flow-insensitive invariant for global unknown. *) + val invariant_vars: Q.ask -> (V.t -> G.t) -> relation_components_t -> varinfo list (** Returns global variables which are privatized. *) @@ -130,6 +133,7 @@ struct {rel = RD.top (); priv = startstate ()} let iter_sys_vars getg vq vf = () + let invariant_global ask getg g = Invariant.none let invariant_vars ask getg st = [] let init () = () @@ -410,6 +414,7 @@ struct {rel = getg (); priv = startstate ()} let iter_sys_vars getg vq vf = () (* TODO: or report singleton global for any Global query? *) + let invariant_global ask getg g = Invariant.none let invariant_vars ask getg st = protected_vars ask (* TODO: is this right? *) let finalize () = () @@ -684,6 +689,8 @@ struct let init () = () let finalize () = () + + let invariant_global ask getg g = Invariant.none (* TODO: implement *) end (** May written variables. *) @@ -1242,6 +1249,8 @@ struct | _ -> () let finalize () = () + + let invariant_global ask getg g = Invariant.none end module TracingPriv = functor (Priv: S) -> functor (RD: RelationDomain.RD) -> From d3565cb8a7903e8604ba89df0867aba8813e4f53 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 Apr 2024 13:42:58 +0300 Subject: [PATCH 060/157] Implement relational mutex-meet flow-insensitive invariants --- src/analyses/apron/relationPriv.apron.ml | 19 ++++++++++++++++++- .../regression/36-apron/12-traces-min-rpb1.t | 12 ++++++++---- 2 files changed, 26 insertions(+), 5 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index f286287dbe..a75e2ef113 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -690,7 +690,24 @@ struct let init () = () let finalize () = () - let invariant_global ask getg g = Invariant.none (* TODO: implement *) + let invariant_global (ask: Q.ask) (getg: V.t -> G.t): V.t -> Invariant.t = function + | `Left m' as m -> (* mutex *) + if ask.f (GhostVarAvailable (Locked m')) then ( + let cpa = getg m in + let inv = + RD.invariant cpa + (* TODO: filters like query_invariant? *) + |> List.filter_map RD.cil_exp_of_lincons1 + |> List.fold_left (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none + (* TODO: need to filter for MustBeProtectedBy like base mutex-meet? *) + in + let var = WitnessGhost.to_varinfo (Locked m') in + Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) + else + Invariant.none + | g -> (* global *) + Invariant.none (* TODO: ? *) end (** May written variables. *) diff --git a/tests/regression/36-apron/12-traces-min-rpb1.t b/tests/regression/36-apron/12-traces-min-rpb1.t index 13cefb9557..e05840429b 100644 --- a/tests/regression/36-apron/12-traces-min-rpb1.t +++ b/tests/regression/36-apron/12-traces-min-rpb1.t @@ -1,4 +1,4 @@ - $ goblint --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 12-traces-min-rpb1.c + $ goblint --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:16:3-16:26) [Warning][Assert] Assertion "g == h" is unknown. (12-traces-min-rpb1.c:27:3-27:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:29:3-29:26) @@ -13,15 +13,13 @@ write with [lock:{A}, thread:[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]] (conf. 110) (exp: & g) (12-traces-min-rpb1.c:14:3-14:8) read with [mhp:{created={[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]}}, thread:[main]] (conf. 110) (exp: & g) (12-traces-min-rpb1.c:27:3-27:26) [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 10 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 unsafe: 2 total memory locations: 2 -TODO: emit g == h - $ yamlWitnessStrip < witness.yml - entry_type: ghost_update variable: multithreaded @@ -96,3 +94,9 @@ TODO: emit g == h scope: global type: int initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (A_locked || ((0LL - (long long )g) + (long long )h + >= 0LL && (long long )g - (long long )h >= 0LL))' + type: assertion + format: C From 1aa35d85b74c24e14c471b7d174dc441cccdbd72 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 Apr 2024 14:46:48 +0300 Subject: [PATCH 061/157] Filter relational mutex-meet ghost invariant with keep_only_protected_globals lock does it too, so let's be safe. --- src/analyses/apron/relationPriv.apron.ml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index a75e2ef113..b73319b4df 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -693,13 +693,12 @@ struct let invariant_global (ask: Q.ask) (getg: V.t -> G.t): V.t -> Invariant.t = function | `Left m' as m -> (* mutex *) if ask.f (GhostVarAvailable (Locked m')) then ( - let cpa = getg m in + let rel = keep_only_protected_globals ask m' (getg m) in let inv = - RD.invariant cpa + RD.invariant rel (* TODO: filters like query_invariant? *) |> List.filter_map RD.cil_exp_of_lincons1 |> List.fold_left (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none - (* TODO: need to filter for MustBeProtectedBy like base mutex-meet? *) in let var = WitnessGhost.to_varinfo (Locked m') in Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) From c4a8936a2bd36d88cdc2909872aa6e6634098653 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 Apr 2024 14:53:57 +0300 Subject: [PATCH 062/157] Add filters to relational InvariantGlobal --- src/analyses/apron/relationAnalysis.apron.ml | 3 +-- src/analyses/apron/relationPriv.apron.ml | 18 +++++++++++++++--- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index ba5b90525c..397301b7bc 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -635,8 +635,7 @@ struct |> Enum.fold (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none let query_invariant_global ctx g = - (* TODO: option? *) - if ctx.ask (GhostVarAvailable Multithreaded) then ( + if GobConfig.get_bool "ana.relation.invariant.global" && ctx.ask (GhostVarAvailable Multithreaded) then ( let var = WitnessGhost.to_varinfo Multithreaded in let inv = Priv.invariant_global (Analyses.ask_of_ctx ctx) ctx.global g in Invariant.(of_exp (UnOp (LNot, Lval (GoblintCil.var var), GoblintCil.intType)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index b73319b4df..dcb3b166c3 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -693,12 +693,24 @@ struct let invariant_global (ask: Q.ask) (getg: V.t -> G.t): V.t -> Invariant.t = function | `Left m' as m -> (* mutex *) if ask.f (GhostVarAvailable (Locked m')) then ( + (* filters like query_invariant *) + let one_var = GobConfig.get_bool "ana.relation.invariant.one-var" in + let exact = GobConfig.get_bool "witness.invariant.exact" in + let rel = keep_only_protected_globals ask m' (getg m) in let inv = RD.invariant rel - (* TODO: filters like query_invariant? *) - |> List.filter_map RD.cil_exp_of_lincons1 - |> List.fold_left (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none + |> List.enum + |> Enum.filter_map (fun (lincons1: Apron.Lincons1.t) -> + (* filter one-vars and exact *) + (* TODO: exact filtering doesn't really work with octagon because it returns two SUPEQ constraints instead *) + if (one_var || GobApron.Lincons1.num_vars lincons1 >= 2) && (exact || Apron.Lincons1.get_typ lincons1 <> EQ) then + RD.cil_exp_of_lincons1 lincons1 + |> Option.filter (fun exp -> not (InvariantCil.exp_contains_tmp exp)) + else + None + ) + |> Enum.fold (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none in let var = WitnessGhost.to_varinfo (Locked m') in Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) From 535de765401c7a865c5c44be6b06f4aff85a7b65 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 7 May 2024 15:52:17 +0300 Subject: [PATCH 063/157] Add test with __VERIFIER_atomic_locked ghost variable --- tests/regression/29-svcomp/16-atomic_priv.t | 92 +++++++++++++++++++++ 1 file changed, 92 insertions(+) diff --git a/tests/regression/29-svcomp/16-atomic_priv.t b/tests/regression/29-svcomp/16-atomic_priv.t index 15425f68dd..d3826d8de3 100644 --- a/tests/regression/29-svcomp/16-atomic_priv.t +++ b/tests/regression/29-svcomp/16-atomic_priv.t @@ -81,3 +81,95 @@ string: '! multithreaded || myglobal == 5' type: assertion format: C + +Non-atomic privatization: + + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 16-atomic_priv.c + [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) + [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) + [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) + [Warning][Assert] Assertion "myglobal == 5" is unknown. (16-atomic_priv.c:24:3-24:33) + [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:26:3-26:33) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 17 + dead: 0 + total lines: 17 + [Warning][Race] Memory location myglobal (race with conf. 110): (16-atomic_priv.c:8:5-8:17) + write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:13:3-13:13) + write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:15:3-15:13) + read with [mhp:{created={[main, t_fun@16-atomic_priv.c:23:3-23:40]}}, thread:[main]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:24:3-24:33) + [Info][Witness] witness generation summary: + total generation entries: 9 + [Info][Race] Memory locations race summary: + safe: 0 + vulnerable: 0 + unsafe: 1 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "1" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 25 + column: 3 + function: main + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "1" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 11 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "0" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 27 + column: 3 + function: main + - entry_type: ghost_update + variable: __VERIFIER_atomic_locked + expression: "0" + location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: __VERIFIER_atomic_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (__VERIFIER_atomic_locked || myglobal == 5)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || ((0 <= myglobal && myglobal <= 127) && myglobal != + 0)' + type: assertion + format: C From 6f3b6fbc6ab0e18560f6cbf5a409b46a6055022d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 7 May 2024 16:13:16 +0300 Subject: [PATCH 064/157] Treat __VERIFIER_atomic_locked as false in witnesses Others cannot observe anything else anyway. But in the atomic section could?! --- src/analyses/apron/relationPriv.apron.ml | 11 ++- src/analyses/basePriv.ml | 15 +++- src/analyses/mutexGhosts.ml | 5 +- src/witness/witnessGhostVar.ml | 2 +- tests/regression/29-svcomp/16-atomic_priv.t | 88 +-------------------- 5 files changed, 26 insertions(+), 95 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index dcb3b166c3..f14700f437 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -692,7 +692,8 @@ struct let invariant_global (ask: Q.ask) (getg: V.t -> G.t): V.t -> Invariant.t = function | `Left m' as m -> (* mutex *) - if ask.f (GhostVarAvailable (Locked m')) then ( + let atomic = LockDomain.Addr.equal m' (LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var) in + if atomic || ask.f (GhostVarAvailable (Locked m')) then ( (* filters like query_invariant *) let one_var = GobConfig.get_bool "ana.relation.invariant.one-var" in let exact = GobConfig.get_bool "witness.invariant.exact" in @@ -712,8 +713,12 @@ struct ) |> Enum.fold (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none in - let var = WitnessGhost.to_varinfo (Locked m') in - Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + if atomic then + inv + else ( + let var = WitnessGhost.to_varinfo (Locked m') in + Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) ) else Invariant.none diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 799290c4fe..af88cfb742 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -333,7 +333,8 @@ struct let invariant_global (ask: Q.ask) getg = function | `Left m' as m -> (* mutex *) - if ask.f (GhostVarAvailable (Locked m')) then ( + let atomic = LockDomain.Addr.equal m' (LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var) in + if atomic || ask.f (GhostVarAvailable (Locked m')) then ( let cpa = getg m in let inv = CPA.fold (fun v _ acc -> if ask.f (MustBeProtectedBy {mutex = m'; global = v; write = true; protection = Strong}) then @@ -343,8 +344,12 @@ struct acc ) cpa Invariant.none in - let var = WitnessGhost.to_varinfo (Locked m') in - Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + if atomic then + inv + else ( + let var = WitnessGhost.to_varinfo (Locked m') in + Invariant.(of_exp (Lval (GoblintCil.var var)) || inv) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) ) else Invariant.none @@ -864,7 +869,9 @@ struct else ( let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) Q.AD.fold (fun m acc -> - if ask.f (GhostVarAvailable (Locked m)) then ( + if LockDomain.Addr.equal m (LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var) then + acc + else if ask.f (GhostVarAvailable (Locked m)) then ( let var = WitnessGhost.to_varinfo (Locked m) in Invariant.(of_exp (Lval (GoblintCil.var var)) || acc) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 75195e4662..eaa15df8e6 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -59,8 +59,9 @@ struct end let event ctx e octx = + let verifier_atomic_addr = LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var in begin match e with - | Events.Lock (l, _) -> + | Events.Lock (l, _) when not (LockDomain.Addr.equal l verifier_atomic_addr) -> ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ())); if !AnalysisState.postsolving then ( let (locked, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in @@ -70,7 +71,7 @@ struct ) locked ); ) - | Events.Unlock l -> + | Events.Unlock l when not (LockDomain.Addr.equal l verifier_atomic_addr) -> ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ())); if !AnalysisState.postsolving then ( let (_, unlocked, _) = G.node (ctx.global (V.node ctx.prev_node)) in diff --git a/src/witness/witnessGhostVar.ml b/src/witness/witnessGhostVar.ml index cec61b0e2d..7979d23173 100644 --- a/src/witness/witnessGhostVar.ml +++ b/src/witness/witnessGhostVar.ml @@ -9,7 +9,7 @@ let name_varinfo = function | Locked (Addr (v, os)) -> let name = if CilType.Varinfo.equal v LibraryFunctions.verifier_atomic_var then - "__VERIFIER_atomic" + invalid_arg "__VERIFIER_atomic" else if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo v then Printf.sprintf "alloc_%s%d" (if v.vid < 0 then "m" else "") (abs v.vid) (* turn minus into valid C name *) diff --git a/tests/regression/29-svcomp/16-atomic_priv.t b/tests/regression/29-svcomp/16-atomic_priv.t index d3826d8de3..b10265d4e8 100644 --- a/tests/regression/29-svcomp/16-atomic_priv.t +++ b/tests/regression/29-svcomp/16-atomic_priv.t @@ -13,7 +13,7 @@ write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:15:3-15:13) read with [mhp:{created={[main, t_fun@16-atomic_priv.c:23:3-23:40]}}, thread:[main]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:24:3-24:33) [Info][Witness] witness generation summary: - total generation entries: 8 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 @@ -30,52 +30,11 @@ line: 23 column: 3 function: main - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "1" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 25 - column: 3 - function: main - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "1" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 11 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "0" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 27 - column: 3 - function: main - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "0" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - entry_type: ghost_variable variable: multithreaded scope: global type: int initial: "0" - - entry_type: ghost_variable - variable: __VERIFIER_atomic_locked - scope: global - type: int - initial: "0" - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || myglobal == 5' @@ -99,7 +58,7 @@ Non-atomic privatization: write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:15:3-15:13) read with [mhp:{created={[main, t_fun@16-atomic_priv.c:23:3-23:40]}}, thread:[main]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:24:3-24:33) [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 4 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 @@ -116,55 +75,14 @@ Non-atomic privatization: line: 23 column: 3 function: main - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "1" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 25 - column: 3 - function: main - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "1" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 11 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "0" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 27 - column: 3 - function: main - - entry_type: ghost_update - variable: __VERIFIER_atomic_locked - expression: "0" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - entry_type: ghost_variable variable: multithreaded scope: global type: int initial: "0" - - entry_type: ghost_variable - variable: __VERIFIER_atomic_locked - scope: global - type: int - initial: "0" - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (__VERIFIER_atomic_locked || myglobal == 5)' + string: '! multithreaded || myglobal == 5' type: assertion format: C - entry_type: flow_insensitive_invariant From 2e6673f72e1e3df8c67b9c0c21aec9f45e1c4ab2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 8 May 2024 11:41:45 +0300 Subject: [PATCH 065/157] Disable 13-privatized/04-priv_multi cram test on OSX OSX has its own weird diff. --- tests/regression/13-privatized/dune | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/regression/13-privatized/dune b/tests/regression/13-privatized/dune index 23c0dd3290..9227128b15 100644 --- a/tests/regression/13-privatized/dune +++ b/tests/regression/13-privatized/dune @@ -1,2 +1,6 @@ (cram (deps (glob_files *.c))) + +(cram + (applies_to 04-priv_multi) + (enabled_if (<> %{system} macosx))) From b7582a4c5495e35a24974228785817b01711a37c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 8 May 2024 11:43:03 +0300 Subject: [PATCH 066/157] Make 36-apron/12-traces-min-rpb1 cram test warnings deterministic Needed for OSX CI to pass. --- .../regression/36-apron/12-traces-min-rpb1.t | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/regression/36-apron/12-traces-min-rpb1.t b/tests/regression/36-apron/12-traces-min-rpb1.t index e05840429b..7aca1dea0b 100644 --- a/tests/regression/36-apron/12-traces-min-rpb1.t +++ b/tests/regression/36-apron/12-traces-min-rpb1.t @@ -1,24 +1,24 @@ - $ goblint --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box - [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:16:3-16:26) + $ goblint --enable warn.deterministic --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box [Warning][Assert] Assertion "g == h" is unknown. (12-traces-min-rpb1.c:27:3-27:26) + [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:16:3-16:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:29:3-29:26) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 18 - dead: 0 - total lines: 18 - [Warning][Race] Memory location h (race with conf. 110): (12-traces-min-rpb1.c:8:5-8:10) - write with [lock:{A}, thread:[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]] (conf. 110) (exp: & h) (12-traces-min-rpb1.c:15:3-15:8) - read with [mhp:{created={[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]}}, thread:[main]] (conf. 110) (exp: & h) (12-traces-min-rpb1.c:27:3-27:26) [Warning][Race] Memory location g (race with conf. 110): (12-traces-min-rpb1.c:7:5-7:10) write with [lock:{A}, thread:[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]] (conf. 110) (exp: & g) (12-traces-min-rpb1.c:14:3-14:8) read with [mhp:{created={[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]}}, thread:[main]] (conf. 110) (exp: & g) (12-traces-min-rpb1.c:27:3-27:26) - [Info][Witness] witness generation summary: - total generation entries: 10 + [Warning][Race] Memory location h (race with conf. 110): (12-traces-min-rpb1.c:8:5-8:10) + write with [lock:{A}, thread:[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]] (conf. 110) (exp: & h) (12-traces-min-rpb1.c:15:3-15:8) + read with [mhp:{created={[main, t_fun@12-traces-min-rpb1.c:25:3-25:40]}}, thread:[main]] (conf. 110) (exp: & h) (12-traces-min-rpb1.c:27:3-27:26) [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 unsafe: 2 total memory locations: 2 + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 18 + dead: 0 + total lines: 18 + [Info][Witness] witness generation summary: + total generation entries: 10 $ yamlWitnessStrip < witness.yml - entry_type: ghost_update From cad5f6e6c3b047cc30061188b57889b87a8b767a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 20 May 2024 13:03:12 +0300 Subject: [PATCH 067/157] Add BasePriv invariant_global tracing --- src/analyses/basePriv.ml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index af88cfb742..cbc11070d3 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -1917,6 +1917,17 @@ struct if M.tracing then M.traceu "priv" "-> %a" BaseComponents.pretty r; r + let invariant_global ask getg g = + if M.tracing then M.traceli "priv" "invariant_global %a" V.pretty g; + let getg x = + let r = getg x in + if M.tracing then M.trace "priv" "getg %a -> %a" V.pretty x G.pretty r; + r + in + let r = invariant_global ask getg g in + if M.tracing then M.traceu "priv" "-> %a" Invariant.pretty r; + r + end let priv_module: (module S) Lazy.t = From bd329e16f72f296bdf88f46d31fcfc4477db3ffc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 21 May 2024 11:53:44 +0300 Subject: [PATCH 068/157] Fix mutex-meet invariant_global not including MUTEX_INITS --- src/analyses/apron/relationPriv.apron.ml | 4 ++-- src/analyses/basePriv.ml | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index cb71884c8c..5ffb96650c 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -694,14 +694,14 @@ struct let finalize () = () let invariant_global (ask: Q.ask) (getg: V.t -> G.t): V.t -> Invariant.t = function - | `Left m' as m -> (* mutex *) + | `Left m' -> (* mutex *) let atomic = LockDomain.Addr.equal m' (LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var) in if atomic || ask.f (GhostVarAvailable (Locked m')) then ( (* filters like query_invariant *) let one_var = GobConfig.get_bool "ana.relation.invariant.one-var" in let exact = GobConfig.get_bool "witness.invariant.exact" in - let rel = keep_only_protected_globals ask m' (getg m) in + let rel = keep_only_protected_globals ask m' (get_m_with_mutex_inits ask getg m') in (* TODO: disjunct with mutex_inits instead of join? *) let inv = RD.invariant rel |> List.enum diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index cbc11070d3..c244e7f3bf 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -250,7 +250,7 @@ struct let invariant_global ask getg = function | `Right g' -> (* global *) - ValueDomain.invariant_global (read_unprotected_global getg) g' + ValueDomain.invariant_global (read_unprotected_global getg) g' (* TODO: disjunct with mutex_inits instead of join? *) | _ -> (* mutex *) Invariant.none @@ -332,10 +332,10 @@ struct include PerMutexPrivBase let invariant_global (ask: Q.ask) getg = function - | `Left m' as m -> (* mutex *) + | `Left m' -> (* mutex *) let atomic = LockDomain.Addr.equal m' (LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var) in if atomic || ask.f (GhostVarAvailable (Locked m')) then ( - let cpa = getg m in + let cpa = get_m_with_mutex_inits ask getg m' in (* TODO: disjunct with mutex_inits instead of join? *) let inv = CPA.fold (fun v _ acc -> if ask.f (MustBeProtectedBy {mutex = m'; global = v; write = true; protection = Strong}) then let inv = ValueDomain.invariant_global (fun g -> CPA.find g cpa) v in @@ -688,7 +688,7 @@ struct let invariant_global ask getg = function | `Middle g -> (* global *) - ValueDomain.invariant_global (read_unprotected_global getg) g + ValueDomain.invariant_global (read_unprotected_global getg) g (* TODO: disjunct with mutex_inits instead of join? *) | `Left _ | `Right _ -> (* mutex or thread *) Invariant.none From 2a79e42601bcf03c3a446fd7dceafc22096358d1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 10:45:25 +0300 Subject: [PATCH 069/157] Add comment about multiple protecting mutexes for ghost invariants --- src/analyses/basePriv.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index c244e7f3bf..be261d96b7 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -868,6 +868,10 @@ struct Invariant.none (* don't output protected invariant because it's the same as unprotected *) else ( let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) + (* Very conservative about multiple (write-)protecting mutexes: invariant is not claimed when any of them is held. + It should be possible to be more precise because writes only happen with all of them held, + but conjunction is unsound when one of the mutexes is temporarily unlocked. + Hypothetical read-protection is also somehow relevant. *) Q.AD.fold (fun m acc -> if LockDomain.Addr.equal m (LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var) then acc From 2e42c7bf1c664d07ab5844246338547f4d28f3c8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 5 Jun 2024 12:36:10 +0300 Subject: [PATCH 070/157] Add ghost_variable and ghost_update YAML entry types to option --- conf/svcomp-ghost.json | 4 +++- src/analyses/mutexGhosts.ml | 3 +++ src/config/options.schema.json | 4 +++- src/witness/witnessGhost.ml | 3 +++ tests/regression/13-privatized/04-priv_multi.t | 4 ++-- tests/regression/13-privatized/25-struct_nr.t | 2 +- tests/regression/13-privatized/74-mutex.t | 6 +++--- tests/regression/13-privatized/92-idx_priv.t | 2 +- tests/regression/29-svcomp/16-atomic_priv.t | 4 ++-- tests/regression/36-apron/12-traces-min-rpb1.t | 2 +- tests/regression/56-witness/64-ghost-multiple-protecting.t | 6 +++--- tests/regression/56-witness/65-ghost-ambiguous-lock.t | 2 +- tests/regression/56-witness/66-ghost-alloc-lock.t | 2 +- tests/regression/56-witness/67-ghost-no-unlock.t | 2 +- tests/regression/56-witness/68-ghost-ambiguous-idx.t | 2 +- 15 files changed, 29 insertions(+), 19 deletions(-) diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json index 229dd9ef46..84f127eb91 100644 --- a/conf/svcomp-ghost.json +++ b/conf/svcomp-ghost.json @@ -116,7 +116,9 @@ "enabled": true, "format-version": "0.1", "entry-types": [ - "flow_insensitive_invariant" + "flow_insensitive_invariant", + "ghost_variable", + "ghost_update" ] }, "invariant": { diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 159498cfb1..6e95504731 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -96,6 +96,9 @@ struct | Locked _ -> false | Multithreaded -> true + let ghost_var_available ctx v = + WitnessGhost.enabled () && ghost_var_available ctx v + let query ctx (type a) (q: a Queries.t): a Queries.result = match q with | GhostVarAvailable v -> ghost_var_available ctx v diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 4a77aae5f0..779b9bbf65 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -2580,7 +2580,9 @@ "precondition_loop_invariant", "loop_invariant_certificate", "precondition_loop_invariant_certificate", - "invariant_set" + "invariant_set", + "ghost_variable", + "ghost_update" ] }, "default": [ diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index cdd26b36aa..91d513ceae 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -1,5 +1,8 @@ (** Ghost variables for YAML witnesses. *) +let enabled () = + YamlWitness.entry_type_enabled YamlWitnessType.GhostVariable.entry_type && YamlWitness.entry_type_enabled YamlWitnessType.GhostUpdate.entry_type + module Var = WitnessGhostVar include Var diff --git a/tests/regression/13-privatized/04-priv_multi.t b/tests/regression/13-privatized/04-priv_multi.t index 952696a5c4..576c89ad4d 100644 --- a/tests/regression/13-privatized/04-priv_multi.t +++ b/tests/regression/13-privatized/04-priv_multi.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 04-priv_multi.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 04-priv_multi.c [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) [Warning][Deadcode] Function 'dispose' has dead code: @@ -174,7 +174,7 @@ Flow-insensitive invariants as location invariants. - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' --enable witness.invariant.flow_insensitive-as-location 04-priv_multi.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 04-priv_multi.c [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) [Warning][Deadcode] Function 'dispose' has dead code: diff --git a/tests/regression/13-privatized/25-struct_nr.t b/tests/regression/13-privatized/25-struct_nr.t index f3ebcd1c52..342cfaf99c 100644 --- a/tests/regression/13-privatized/25-struct_nr.t +++ b/tests/regression/13-privatized/25-struct_nr.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 25-struct_nr.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 25-struct_nr.c [Success][Assert] Assertion "glob1 == 5" will succeed (25-struct_nr.c:26:3-26:30) [Success][Assert] Assertion "t == 5" will succeed (25-struct_nr.c:16:3-16:26) [Success][Assert] Assertion "glob1 == -10" will succeed (25-struct_nr.c:18:3-18:32) diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index a00f49eb1a..f6f2fa8463 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -84,7 +84,7 @@ Flow-insensitive invariants as location invariants. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' --enable witness.invariant.flow_insensitive-as-location 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -150,7 +150,7 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm Same with mutex-meet. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) diff --git a/tests/regression/13-privatized/92-idx_priv.t b/tests/regression/13-privatized/92-idx_priv.t index 64a3309009..bd6db7e2ef 100644 --- a/tests/regression/13-privatized/92-idx_priv.t +++ b/tests/regression/13-privatized/92-idx_priv.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 92-idx_priv.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 92-idx_priv.c [Success][Assert] Assertion "data == 0" will succeed (92-idx_priv.c:22:3-22:29) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 diff --git a/tests/regression/29-svcomp/16-atomic_priv.t b/tests/regression/29-svcomp/16-atomic_priv.t index b10265d4e8..83bc201a6c 100644 --- a/tests/regression/29-svcomp/16-atomic_priv.t +++ b/tests/regression/29-svcomp/16-atomic_priv.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection-atomic --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 16-atomic_priv.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection-atomic --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) @@ -43,7 +43,7 @@ Non-atomic privatization: - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 16-atomic_priv.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) diff --git a/tests/regression/36-apron/12-traces-min-rpb1.t b/tests/regression/36-apron/12-traces-min-rpb1.t index 7aca1dea0b..1c3253afbc 100644 --- a/tests/regression/36-apron/12-traces-min-rpb1.t +++ b/tests/regression/36-apron/12-traces-min-rpb1.t @@ -1,4 +1,4 @@ - $ goblint --enable warn.deterministic --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box + $ goblint --enable warn.deterministic --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box [Warning][Assert] Assertion "g == h" is unknown. (12-traces-min-rpb1.c:27:3-27:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:16:3-16:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:29:3-29:26) diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t index 53323355c5..943934a7be 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.t +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 @@ -144,7 +144,7 @@ protection doesn't have precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 @@ -295,7 +295,7 @@ protection-read has precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.t b/tests/regression/56-witness/65-ghost-ambiguous-lock.t index 708e27ca64..d7d57d8a00 100644 --- a/tests/regression/56-witness/65-ghost-ambiguous-lock.t +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 65-ghost-ambiguous-lock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 65-ghost-ambiguous-lock.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 23 dead: 0 diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.t b/tests/regression/56-witness/66-ghost-alloc-lock.t index e4d128b71e..e4268ec1cb 100644 --- a/tests/regression/56-witness/66-ghost-alloc-lock.t +++ b/tests/regression/56-witness/66-ghost-alloc-lock.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set ana.malloc.unique_address_count 1 --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 66-ghost-alloc-lock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set ana.malloc.unique_address_count 1 --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 66-ghost-alloc-lock.c [Success][Assert] Assertion "g1 == 0" will succeed (66-ghost-alloc-lock.c:31:3-31:27) [Success][Assert] Assertion "g2 == 0" will succeed (66-ghost-alloc-lock.c:34:3-34:27) [Info][Deadcode] Logical lines of code (LLoC) summary: diff --git a/tests/regression/56-witness/67-ghost-no-unlock.t b/tests/regression/56-witness/67-ghost-no-unlock.t index 491dd9cf44..aed0ac3414 100644 --- a/tests/regression/56-witness/67-ghost-no-unlock.t +++ b/tests/regression/56-witness/67-ghost-no-unlock.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 67-ghost-no-unlock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 67-ghost-no-unlock.c [Success][Assert] Assertion "g1 == 0" will succeed (67-ghost-no-unlock.c:24:3-24:27) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 diff --git a/tests/regression/56-witness/68-ghost-ambiguous-idx.t b/tests/regression/56-witness/68-ghost-ambiguous-idx.t index 48837fcabb..9f50ab7429 100644 --- a/tests/regression/56-witness/68-ghost-ambiguous-idx.t +++ b/tests/regression/56-witness/68-ghost-ambiguous-idx.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant"]' 68-ghost-ambiguous-idx.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 68-ghost-ambiguous-idx.c [Warning][Assert] Assertion "data == 0" is unknown. (68-ghost-ambiguous-idx.c:24:3-24:29) [Warning][Unknown] unlocking mutex (m[4]) which may not be held (68-ghost-ambiguous-idx.c:25:3-25:30) [Info][Deadcode] Logical lines of code (LLoC) summary: From e7931ffe4afc2be4872b15d94a4ab3aa4ed66453 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 5 Jun 2024 12:53:02 +0300 Subject: [PATCH 071/157] Make InvariantGlobalNodes query lazy in YAML witness generation --- src/witness/yamlWitness.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index b7bf11a31c..fd8f4b5249 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -325,7 +325,7 @@ struct (* Generate flow-insensitive invariants *) let entries = if entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type then ( - let ns = R.ask_global InvariantGlobalNodes in + let ns = lazy (R.ask_global InvariantGlobalNodes) in GHT.fold (fun g v acc -> match g with | `Left g -> (* Spec global *) @@ -352,7 +352,7 @@ struct entry :: acc ) acc invs | None -> acc - ) ns acc + ) (Lazy.force ns) acc | `Bot, _ | `Top, _ -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc end From 36ff6217074eb8c25a2528979ebc634d3cba789e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 5 Jun 2024 13:46:04 +0300 Subject: [PATCH 072/157] Fix comment about YamlEntryGlobal --- src/witness/yamlWitness.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index fd8f4b5249..596a35f631 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -364,7 +364,7 @@ struct entries in - (* Generate flow-insensitive invariants *) + (* Generate flow-insensitive entries (ghost variables and ghost updates) *) let entries = if true then ( GHT.fold (fun g v acc -> From 7fcb10cd0fcb4c4f68d43a7bb60fec9d7cfc64d5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 18 Jun 2024 17:20:55 +0300 Subject: [PATCH 073/157] Handle pthread_rwlock_t as opaque mutex in base analysis Avoids unsound rwlock struct content invariants in witnesses. --- src/cdomain/value/cdomains/valueDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomain/value/cdomains/valueDomain.ml b/src/cdomain/value/cdomains/valueDomain.ml index de64fde807..09593fb614 100644 --- a/src/cdomain/value/cdomains/valueDomain.ml +++ b/src/cdomain/value/cdomains/valueDomain.ml @@ -120,7 +120,7 @@ struct | _ -> false let is_mutex_type (t: typ): bool = match t with - | TNamed (info, attr) -> info.tname = "pthread_mutex_t" || info.tname = "spinlock_t" || info.tname = "pthread_spinlock_t" || info.tname = "pthread_cond_t" + | TNamed (info, attr) -> info.tname = "pthread_mutex_t" || info.tname = "spinlock_t" || info.tname = "pthread_spinlock_t" || info.tname = "pthread_cond_t" || info.tname = "pthread_rwlock_t" | TInt (IInt, attr) -> hasAttribute "mutex" attr | _ -> false From a00ca1b507b638cffa7404ee5e5bba9ddaa1a586 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Jul 2024 17:15:07 +0300 Subject: [PATCH 074/157] Remove goblint.build-info.js and goblint.sites.js --- gobview | 2 +- src/build-info/build_info_js/dune | 5 ----- src/build-info/build_info_js/dune_build_info.ml | 1 - src/sites/sites_js/dune | 6 ------ src/sites/sites_js/goblint_sites.ml | 6 ------ 5 files changed, 1 insertion(+), 19 deletions(-) delete mode 100644 src/build-info/build_info_js/dune delete mode 100644 src/build-info/build_info_js/dune_build_info.ml delete mode 100644 src/sites/sites_js/dune delete mode 100644 src/sites/sites_js/goblint_sites.ml diff --git a/gobview b/gobview index 03b0682f97..1895e62dab 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 03b0682f973eab0d26cf8aea74c63a9e869c9716 +Subproject commit 1895e62dab67cfb05a5981bcfd7f36d46acd2b7e diff --git a/src/build-info/build_info_js/dune b/src/build-info/build_info_js/dune deleted file mode 100644 index 9400f564ff..0000000000 --- a/src/build-info/build_info_js/dune +++ /dev/null @@ -1,5 +0,0 @@ -; goblint.build-info implementation which works with js_of_ocaml and doesn't use dune-build-info -(library - (name goblint_build_info_js) - (public_name goblint.build-info.js) - (implements goblint.build-info)) diff --git a/src/build-info/build_info_js/dune_build_info.ml b/src/build-info/build_info_js/dune_build_info.ml deleted file mode 100644 index 002015cd31..0000000000 --- a/src/build-info/build_info_js/dune_build_info.ml +++ /dev/null @@ -1 +0,0 @@ -let statically_linked_libraries = [] diff --git a/src/sites/sites_js/dune b/src/sites/sites_js/dune deleted file mode 100644 index 4e20871974..0000000000 --- a/src/sites/sites_js/dune +++ /dev/null @@ -1,6 +0,0 @@ -; goblint.sites implementation which works with js_of_ocaml and doesn't use dune-site -(library - (name goblint_sites_js) - (public_name goblint.sites.js) - (implements goblint.sites) - (modules goblint_sites)) diff --git a/src/sites/sites_js/goblint_sites.ml b/src/sites/sites_js/goblint_sites.ml deleted file mode 100644 index 3a7b353064..0000000000 --- a/src/sites/sites_js/goblint_sites.ml +++ /dev/null @@ -1,6 +0,0 @@ -let lib = [] -let lib_stub_include = [] -let lib_stub_src = [] -let lib_runtime_include = [] -let lib_runtime_src = [] -let conf = [] From 5a50fa1e16e63ab3ebe5004dce2a3bf3cb4aba6f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Jul 2024 17:26:08 +0300 Subject: [PATCH 075/157] Unvirtualize goblint.build-info and goblint.sites --- gobview | 2 +- src/build-info/build_info_dune/dune | 6 ------ src/build-info/dune | 8 +------- .../{build_info_dune => }/dune_build_info.ml | 0 src/dune | 8 ++++---- src/sites/dune | 12 +++++------- src/sites/{sites_dune => }/goblint_sites.ml | 0 src/sites/sites_dune/dune | 12 ------------ tests/regression/cfg/util/dune | 4 ++-- tests/unit/dune | 2 +- tests/util/dune | 4 ++-- 11 files changed, 16 insertions(+), 42 deletions(-) delete mode 100644 src/build-info/build_info_dune/dune rename src/build-info/{build_info_dune => }/dune_build_info.ml (100%) rename src/sites/{sites_dune => }/goblint_sites.ml (100%) delete mode 100644 src/sites/sites_dune/dune diff --git a/gobview b/gobview index 1895e62dab..f9ce8bcad3 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 1895e62dab67cfb05a5981bcfd7f36d46acd2b7e +Subproject commit f9ce8bcad3552ad95488bc4988dcc0d5ed57b365 diff --git a/src/build-info/build_info_dune/dune b/src/build-info/build_info_dune/dune deleted file mode 100644 index ec46f4b3d1..0000000000 --- a/src/build-info/build_info_dune/dune +++ /dev/null @@ -1,6 +0,0 @@ -; goblint.build-info implementation which properly uses dune-build-info -(library - (name goblint_build_info_dune) - (public_name goblint.build-info.dune) - (implements goblint.build-info) - (libraries dune-build-info)) diff --git a/src/build-info/dune b/src/build-info/dune index e1a45ef8fc..4ffa1f4550 100644 --- a/src/build-info/dune +++ b/src/build-info/dune @@ -1,15 +1,9 @@ (include_subdirs no) -; virtual library to allow js build (for gobview) without dune-build-info -; dune-build-info seems to be incompatible with js_of_ocaml -; File "gobview/src/.App.eobjs/build_info_data.ml-gen", line 1: -; Error: Could not find the .cmi file for interface -; gobview/src/.App.eobjs/build_info_data.ml-gen. (library (name goblint_build_info) (public_name goblint.build-info) - (libraries batteries.unthreaded) - (virtual_modules dune_build_info)) + (libraries dune-build-info batteries.unthreaded)) (rule (target configVersion.ml) diff --git a/src/build-info/build_info_dune/dune_build_info.ml b/src/build-info/dune_build_info.ml similarity index 100% rename from src/build-info/build_info_dune/dune_build_info.ml rename to src/build-info/dune_build_info.ml diff --git a/src/dune b/src/dune index 5265821b5a..c549fd5d7d 100644 --- a/src/dune +++ b/src/dune @@ -88,7 +88,7 @@ (public_names goblint) (modes byte native) ; https://dune.readthedocs.io/en/stable/dune-files.html#linking-modes (modules goblint) - (libraries goblint.lib goblint.sites.dune goblint.build-info.dune goblint_std) + (libraries goblint.lib goblint.sites goblint.build-info goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) @@ -96,7 +96,7 @@ (executable (name privPrecCompare) (modules privPrecCompare) - (libraries goblint.lib goblint.sites.dune goblint.build-info.dune goblint_std) + (libraries goblint.lib goblint.sites goblint.build-info goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) @@ -104,7 +104,7 @@ (executable (name apronPrecCompare) (modules apronPrecCompare) - (libraries goblint.lib goblint.sites.dune goblint.build-info.dune goblint_std) + (libraries goblint.lib goblint.sites goblint.build-info goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) @@ -112,7 +112,7 @@ (executable (name messagesCompare) (modules messagesCompare) - (libraries goblint.lib goblint.sites.dune goblint.build-info.dune goblint_std) + (libraries goblint.lib goblint.sites goblint.build-info goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) diff --git a/src/sites/dune b/src/sites/dune index d8663e37fe..6de3a5a32a 100644 --- a/src/sites/dune +++ b/src/sites/dune @@ -1,12 +1,10 @@ (include_subdirs no) -; virtual library to allow js build (for gobview) without dune-site -; dune-site seems to be incompatible with js_of_ocaml -; File "gobview/src/.App.eobjs/dune_site_data.ml-gen", line 1: -; Error: Could not find the .cmi file for interface -; gobview/src/.App.eobjs/dune_site_data.ml-gen. (library (name goblint_sites) (public_name goblint.sites) - (virtual_modules goblint_sites) - (libraries fpath)) + (libraries dune-site fpath)) + +(generate_sites_module + (module dunesite) + (sites goblint)) diff --git a/src/sites/sites_dune/goblint_sites.ml b/src/sites/goblint_sites.ml similarity index 100% rename from src/sites/sites_dune/goblint_sites.ml rename to src/sites/goblint_sites.ml diff --git a/src/sites/sites_dune/dune b/src/sites/sites_dune/dune deleted file mode 100644 index b7f90a8892..0000000000 --- a/src/sites/sites_dune/dune +++ /dev/null @@ -1,12 +0,0 @@ -; goblint.sites implementation which properly uses dune-site -(library - (name goblint_sites_dune) - (public_name goblint.sites.dune) - (implements goblint.sites) - (modules goblint_sites dunesite) - (private_modules dunesite) ; must also be in modules - (libraries dune-site)) - -(generate_sites_module - (module dunesite) - (sites goblint)) diff --git a/tests/regression/cfg/util/dune b/tests/regression/cfg/util/dune index fb3c5e6899..4c41de07e4 100644 --- a/tests/regression/cfg/util/dune +++ b/tests/regression/cfg/util/dune @@ -6,6 +6,6 @@ goblint_common goblint_lib ; TODO: avoid: extract LoopUnrolling and WitnessUtil node predicates from goblint_lib fpath - goblint.sites.dune - goblint.build-info.dune) + goblint.sites + goblint.build-info) (preprocess (pps ppx_deriving.std))) diff --git a/tests/unit/dune b/tests/unit/dune index 5f0b909a77..6c3083dc1a 100644 --- a/tests/unit/dune +++ b/tests/unit/dune @@ -2,7 +2,7 @@ (test (name mainTest) - (libraries ounit2 qcheck-ounit goblint.std goblint.common goblint.lib goblint.constraint goblint.solver goblint.cdomain.value goblint.sites.dune goblint.build-info.dune) + (libraries ounit2 qcheck-ounit goblint.std goblint.common goblint.lib goblint.constraint goblint.solver goblint.cdomain.value goblint.sites goblint.build-info) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall)) diff --git a/tests/util/dune b/tests/util/dune index 6637217651..fb630bd15b 100644 --- a/tests/util/dune +++ b/tests/util/dune @@ -5,7 +5,7 @@ goblint_std goblint_lib yaml - goblint.sites.dune - goblint.build-info.dune) + goblint.sites + goblint.build-info) (flags :standard -open Goblint_std) (preprocess (pps ppx_deriving.std))) From a5ab08b1a744f647ea4ef86a24173b6d545c103f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Jul 2024 17:27:39 +0300 Subject: [PATCH 076/157] Remove unused goblint.build-info and goblint.sites dependency from most executables --- gobview | 2 +- src/dune | 8 ++++---- src/index.mld | 6 ------ tests/regression/cfg/util/dune | 4 +--- tests/unit/dune | 2 +- tests/util/dune | 4 +--- 6 files changed, 8 insertions(+), 18 deletions(-) diff --git a/gobview b/gobview index f9ce8bcad3..4e965cf1bb 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit f9ce8bcad3552ad95488bc4988dcc0d5ed57b365 +Subproject commit 4e965cf1bb7be5e7ceef2a40586ea445682cca64 diff --git a/src/dune b/src/dune index c549fd5d7d..2ba497c629 100644 --- a/src/dune +++ b/src/dune @@ -88,7 +88,7 @@ (public_names goblint) (modes byte native) ; https://dune.readthedocs.io/en/stable/dune-files.html#linking-modes (modules goblint) - (libraries goblint.lib goblint.sites goblint.build-info goblint_std) + (libraries goblint.lib goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) @@ -96,7 +96,7 @@ (executable (name privPrecCompare) (modules privPrecCompare) - (libraries goblint.lib goblint.sites goblint.build-info goblint_std) + (libraries goblint.lib goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) @@ -104,7 +104,7 @@ (executable (name apronPrecCompare) (modules apronPrecCompare) - (libraries goblint.lib goblint.sites goblint.build-info goblint_std) + (libraries goblint.lib goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) @@ -112,7 +112,7 @@ (executable (name messagesCompare) (modules messagesCompare) - (libraries goblint.lib goblint.sites goblint.build-info goblint_std) + (libraries goblint.lib goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) ) diff --git a/src/index.mld b/src/index.mld index f0d63a0fc7..a2ef15482e 100644 --- a/src/index.mld +++ b/src/index.mld @@ -44,15 +44,9 @@ The following libraries provide [goblint] package metadata for executables. {2 Library goblint.build-info} {!modules:Goblint_build_info} -This library is virtual and has the following implementations -- goblint.build-info.dune for native executables, -- goblint.build-info.js for js_of_ocaml executables. {2 Library goblint.sites} {!modules:Goblint_sites} -This library is virtual and has the following implementations -- goblint.sites.dune for native executables, -- goblint.sites.js for js_of_ocaml executables. {1 Independent utilities} diff --git a/tests/regression/cfg/util/dune b/tests/regression/cfg/util/dune index 4c41de07e4..8ab300b531 100644 --- a/tests/regression/cfg/util/dune +++ b/tests/regression/cfg/util/dune @@ -5,7 +5,5 @@ goblint_logs goblint_common goblint_lib ; TODO: avoid: extract LoopUnrolling and WitnessUtil node predicates from goblint_lib - fpath - goblint.sites - goblint.build-info) + fpath) (preprocess (pps ppx_deriving.std))) diff --git a/tests/unit/dune b/tests/unit/dune index 6c3083dc1a..07c87e7822 100644 --- a/tests/unit/dune +++ b/tests/unit/dune @@ -2,7 +2,7 @@ (test (name mainTest) - (libraries ounit2 qcheck-ounit goblint.std goblint.common goblint.lib goblint.constraint goblint.solver goblint.cdomain.value goblint.sites goblint.build-info) + (libraries ounit2 qcheck-ounit goblint.std goblint.common goblint.lib goblint.constraint goblint.solver goblint.cdomain.value) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall)) diff --git a/tests/util/dune b/tests/util/dune index fb630bd15b..d37c38dc7c 100644 --- a/tests/util/dune +++ b/tests/util/dune @@ -4,8 +4,6 @@ batteries.unthreaded goblint_std goblint_lib - yaml - goblint.sites - goblint.build-info) + yaml) (flags :standard -open Goblint_std) (preprocess (pps ppx_deriving.std))) From c18061e000b830157f17f09c544320a83f9d756a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 Jul 2024 11:26:54 +0300 Subject: [PATCH 077/157] Remove pthreadMutexType from ghost witness tests It is now enabled by default and default mutex type is assumed non-recursive now. --- .../regression/13-privatized/04-priv_multi.t | 4 +-- tests/regression/13-privatized/25-struct_nr.t | 2 +- tests/regression/13-privatized/74-mutex.c | 4 +-- tests/regression/13-privatized/74-mutex.t | 26 +++++++++---------- tests/regression/13-privatized/92-idx_priv.t | 2 +- tests/regression/29-svcomp/16-atomic_priv.t | 4 +-- .../regression/36-apron/12-traces-min-rpb1.t | 2 +- .../56-witness/64-ghost-multiple-protecting.c | 2 +- .../56-witness/64-ghost-multiple-protecting.t | 6 ++--- .../56-witness/65-ghost-ambiguous-lock.c | 2 +- .../56-witness/65-ghost-ambiguous-lock.t | 2 +- .../56-witness/66-ghost-alloc-lock.c | 8 +++--- .../56-witness/66-ghost-alloc-lock.t | 26 +++++++++---------- .../56-witness/67-ghost-no-unlock.c | 2 +- .../56-witness/67-ghost-no-unlock.t | 2 +- .../56-witness/68-ghost-ambiguous-idx.t | 2 +- 16 files changed, 48 insertions(+), 48 deletions(-) diff --git a/tests/regression/13-privatized/04-priv_multi.t b/tests/regression/13-privatized/04-priv_multi.t index 576c89ad4d..b1a45dd917 100644 --- a/tests/regression/13-privatized/04-priv_multi.t +++ b/tests/regression/13-privatized/04-priv_multi.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 04-priv_multi.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 04-priv_multi.c [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) [Warning][Deadcode] Function 'dispose' has dead code: @@ -174,7 +174,7 @@ Flow-insensitive invariants as location invariants. - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 04-priv_multi.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 04-priv_multi.c [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) [Warning][Deadcode] Function 'dispose' has dead code: diff --git a/tests/regression/13-privatized/25-struct_nr.t b/tests/regression/13-privatized/25-struct_nr.t index 342cfaf99c..88f205a431 100644 --- a/tests/regression/13-privatized/25-struct_nr.t +++ b/tests/regression/13-privatized/25-struct_nr.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 25-struct_nr.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 25-struct_nr.c [Success][Assert] Assertion "glob1 == 5" will succeed (25-struct_nr.c:26:3-26:30) [Success][Assert] Assertion "t == 5" will succeed (25-struct_nr.c:16:3-16:26) [Success][Assert] Assertion "glob1 == -10" will succeed (25-struct_nr.c:18:3-18:32) diff --git a/tests/regression/13-privatized/74-mutex.c b/tests/regression/13-privatized/74-mutex.c index 7c57688238..8ed9448b7b 100644 --- a/tests/regression/13-privatized/74-mutex.c +++ b/tests/regression/13-privatized/74-mutex.c @@ -29,8 +29,8 @@ void* producer() int main() { pthread_t tid; - pthread_mutexattr_t mutexattr; pthread_mutexattr_settype(&mutexattr, PTHREAD_MUTEX_NORMAL); - pthread_mutex_init(&m, &mutexattr); + + pthread_mutex_init(&m, 0); pthread_create(&tid, 0, producer, 0); pthread_mutex_lock(&m); diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index f6f2fa8463..8999d394ec 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -1,11 +1,11 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 15 + live: 14 dead: 1 - total lines: 16 + total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: total generation entries: 9 @@ -84,14 +84,14 @@ Flow-insensitive invariants as location invariants. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 15 + live: 14 dead: 1 - total lines: 16 + total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: total generation entries: 9 @@ -138,9 +138,9 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 15 + live: 14 dead: 1 - total lines: 16 + total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Race] Memory locations race summary: safe: 1 @@ -150,14 +150,14 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm Same with mutex-meet. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 15 + live: 14 dead: 1 - total lines: 16 + total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: total generation entries: 9 @@ -241,9 +241,9 @@ Should also work with earlyglobs. [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 15 + live: 14 dead: 1 - total lines: 16 + total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Race] Memory locations race summary: safe: 1 diff --git a/tests/regression/13-privatized/92-idx_priv.t b/tests/regression/13-privatized/92-idx_priv.t index bd6db7e2ef..b157dfed4b 100644 --- a/tests/regression/13-privatized/92-idx_priv.t +++ b/tests/regression/13-privatized/92-idx_priv.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 92-idx_priv.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 92-idx_priv.c [Success][Assert] Assertion "data == 0" will succeed (92-idx_priv.c:22:3-22:29) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 diff --git a/tests/regression/29-svcomp/16-atomic_priv.t b/tests/regression/29-svcomp/16-atomic_priv.t index 83bc201a6c..eea47295d5 100644 --- a/tests/regression/29-svcomp/16-atomic_priv.t +++ b/tests/regression/29-svcomp/16-atomic_priv.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection-atomic --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection-atomic --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) @@ -43,7 +43,7 @@ Non-atomic privatization: - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) diff --git a/tests/regression/36-apron/12-traces-min-rpb1.t b/tests/regression/36-apron/12-traces-min-rpb1.t index 1c3253afbc..df34013d16 100644 --- a/tests/regression/36-apron/12-traces-min-rpb1.t +++ b/tests/regression/36-apron/12-traces-min-rpb1.t @@ -1,4 +1,4 @@ - $ goblint --enable warn.deterministic --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box + $ goblint --enable warn.deterministic --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box [Warning][Assert] Assertion "g == h" is unknown. (12-traces-min-rpb1.c:27:3-27:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:16:3-16:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:29:3-29:26) diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.c b/tests/regression/56-witness/64-ghost-multiple-protecting.c index 589aa92bff..699d133f2b 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.c +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType +// PARAM: --set ana.activated[+] mutexGhosts #include #include int g1, g2; diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t index 943934a7be..e78d0d75aa 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.t +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 @@ -144,7 +144,7 @@ protection doesn't have precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 @@ -295,7 +295,7 @@ protection-read has precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.c b/tests/regression/56-witness/65-ghost-ambiguous-lock.c index b1df0ee2e8..f45334e755 100644 --- a/tests/regression/56-witness/65-ghost-ambiguous-lock.c +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType +// PARAM: --set ana.activated[+] mutexGhosts #include #include diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.t b/tests/regression/56-witness/65-ghost-ambiguous-lock.t index d7d57d8a00..a6e0c12b74 100644 --- a/tests/regression/56-witness/65-ghost-ambiguous-lock.t +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 65-ghost-ambiguous-lock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 65-ghost-ambiguous-lock.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 23 dead: 0 diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.c b/tests/regression/56-witness/66-ghost-alloc-lock.c index 2c1028564a..073540b9db 100644 --- a/tests/regression/56-witness/66-ghost-alloc-lock.c +++ b/tests/regression/56-witness/66-ghost-alloc-lock.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set ana.malloc.unique_address_count 1 +// PARAM: --set ana.activated[+] mutexGhosts --set ana.malloc.unique_address_count 1 #include #include @@ -18,11 +18,11 @@ void *t_fun(void *arg) { return NULL; } -int main() { pthread_mutexattr_t attr; pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_NORMAL); // https://github.com/goblint/analyzer/pull/1414 +int main() { m1 = malloc(sizeof(pthread_mutex_t)); - pthread_mutex_init(m1, &attr); + pthread_mutex_init(m1, NULL); m2 = malloc(sizeof(pthread_mutex_t)); - pthread_mutex_init(m2, &attr); + pthread_mutex_init(m2, NULL); pthread_t id; pthread_create(&id, NULL, t_fun, NULL); diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.t b/tests/regression/56-witness/66-ghost-alloc-lock.t index e4268ec1cb..8e45272538 100644 --- a/tests/regression/56-witness/66-ghost-alloc-lock.t +++ b/tests/regression/56-witness/66-ghost-alloc-lock.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set ana.malloc.unique_address_count 1 --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 66-ghost-alloc-lock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.malloc.unique_address_count 1 --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 66-ghost-alloc-lock.c [Success][Assert] Assertion "g1 == 0" will succeed (66-ghost-alloc-lock.c:31:3-31:27) [Success][Assert] Assertion "g2 == 0" will succeed (66-ghost-alloc-lock.c:34:3-34:27) [Info][Deadcode] Logical lines of code (LLoC) summary: @@ -24,7 +24,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m817990718_locked + variable: alloc_m861095507_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -33,7 +33,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m817990718_locked + variable: alloc_m861095507_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -42,7 +42,7 @@ column: 3 function: t_fun - entry_type: ghost_update - variable: alloc_m817990718_locked + variable: alloc_m861095507_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -51,7 +51,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m817990718_locked + variable: alloc_m861095507_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -60,7 +60,7 @@ column: 3 function: t_fun - entry_type: ghost_update - variable: alloc_m334174073_locked + variable: alloc_m559918035_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -69,7 +69,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m334174073_locked + variable: alloc_m559918035_locked expression: "1" location: file_name: 66-ghost-alloc-lock.c @@ -78,7 +78,7 @@ column: 3 function: t_fun - entry_type: ghost_update - variable: alloc_m334174073_locked + variable: alloc_m559918035_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -87,7 +87,7 @@ column: 3 function: main - entry_type: ghost_update - variable: alloc_m334174073_locked + variable: alloc_m559918035_locked expression: "0" location: file_name: 66-ghost-alloc-lock.c @@ -101,23 +101,23 @@ type: int initial: "0" - entry_type: ghost_variable - variable: alloc_m817990718_locked + variable: alloc_m861095507_locked scope: global type: int initial: "0" - entry_type: ghost_variable - variable: alloc_m334174073_locked + variable: alloc_m559918035_locked scope: global type: int initial: "0" - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (alloc_m817990718_locked || g2 == 0)' + string: '! multithreaded || (alloc_m861095507_locked || g2 == 0)' type: assertion format: C - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (alloc_m334174073_locked || g1 == 0)' + string: '! multithreaded || (alloc_m559918035_locked || g1 == 0)' type: assertion format: C - entry_type: flow_insensitive_invariant diff --git a/tests/regression/56-witness/67-ghost-no-unlock.c b/tests/regression/56-witness/67-ghost-no-unlock.c index fc10b919d0..69ad571118 100644 --- a/tests/regression/56-witness/67-ghost-no-unlock.c +++ b/tests/regression/56-witness/67-ghost-no-unlock.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType +// PARAM: --set ana.activated[+] mutexGhosts #include #include diff --git a/tests/regression/56-witness/67-ghost-no-unlock.t b/tests/regression/56-witness/67-ghost-no-unlock.t index aed0ac3414..85b7a0b897 100644 --- a/tests/regression/56-witness/67-ghost-no-unlock.t +++ b/tests/regression/56-witness/67-ghost-no-unlock.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 67-ghost-no-unlock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 67-ghost-no-unlock.c [Success][Assert] Assertion "g1 == 0" will succeed (67-ghost-no-unlock.c:24:3-24:27) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 diff --git a/tests/regression/56-witness/68-ghost-ambiguous-idx.t b/tests/regression/56-witness/68-ghost-ambiguous-idx.t index 9f50ab7429..02cecfd8f6 100644 --- a/tests/regression/56-witness/68-ghost-ambiguous-idx.t +++ b/tests/regression/56-witness/68-ghost-ambiguous-idx.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.activated[+] pthreadMutexType --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 68-ghost-ambiguous-idx.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 68-ghost-ambiguous-idx.c [Warning][Assert] Assertion "data == 0" is unknown. (68-ghost-ambiguous-idx.c:24:3-24:29) [Warning][Unknown] unlocking mutex (m[4]) which may not be held (68-ghost-ambiguous-idx.c:25:3-25:30) [Info][Deadcode] Logical lines of code (LLoC) summary: From 6055e8dd7e768d2b061c16b9da61a579e120b146 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 Jul 2024 11:29:15 +0300 Subject: [PATCH 078/157] Activate abortUnless in svcomp-ghost conf also --- conf/svcomp-ghost.json | 1 + 1 file changed, 1 insertion(+) diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json index 84f127eb91..108b261322 100644 --- a/conf/svcomp-ghost.json +++ b/conf/svcomp-ghost.json @@ -31,6 +31,7 @@ "region", "thread", "threadJoins", + "abortUnless", "mutexGhosts", "pthreadMutexType" ], From 6e793142a53781763f9232d31302c5d21fea3b47 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 Jul 2024 11:31:52 +0300 Subject: [PATCH 079/157] Update TODO comment about base earlyglobs flow-insensitive invariants --- src/analyses/base.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 4ae2fc711c..782b5662c6 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1247,8 +1247,8 @@ struct let query_invariant_global ctx g = if GobConfig.get_bool "ana.base.invariant.enabled" then ( (* Currently these global invariants are only sound with earlyglobs enabled for both single- and multi-threaded programs. - Otherwise, the values of globals in single-threaded mode are not accounted for. *) - (* TODO: account for single-threaded values without earlyglobs. *) + Otherwise, the values of globals in single-threaded mode are not accounted for. + They are also made sound without earlyglobs using the multithreaded mode ghost variable. *) match g with | `Left g' -> (* priv *) let inv = Priv.invariant_global (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) g' in From d937d68202ff9c4d43721f5439c64c3c4a1a3bbe Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Aug 2024 11:53:06 +0300 Subject: [PATCH 080/157] Add options ana.base.invariant.local and ana.base.invariant.global --- src/analyses/base.ml | 42 ++++++++++++++++++++++++++-------- src/config/options.schema.json | 12 ++++++++++ 2 files changed, 44 insertions(+), 10 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index aa11584f53..f9267ba1d0 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1183,6 +1183,9 @@ struct not is_alloc || (is_alloc && not (ctx.ask (Queries.IsHeapVar v))) let query_invariant ctx context = + let keep_local = GobConfig.get_bool "ana.base.invariant.local" in + let keep_global = GobConfig.get_bool "ana.base.invariant.global" in + let cpa = ctx.local.BaseDomain.cpa in let ask = Analyses.ask_of_ctx ctx in @@ -1195,6 +1198,13 @@ struct in let module I = ValueDomain.ValueInvariant (Arg) in + let var_filter v = + if is_global ask v then + keep_global + else + keep_local + in + let var_invariant ?offset v = if not (InvariantCil.var_is_heap v) then I.key_invariant v ?offset (Arg.find v) @@ -1205,14 +1215,23 @@ struct if Lval.Set.is_top context.Invariant.lvals then ( if !earlyglobs || ThreadFlag.has_ever_been_multi ask then ( let cpa_invariant = - CPA.fold (fun k v a -> - if not (is_global ask k) then - Invariant.(a && var_invariant k) - else - a - ) cpa Invariant.none + if keep_local then ( + CPA.fold (fun k v a -> + if not (is_global ask k) then + Invariant.(a && var_invariant k) + else + a + ) cpa Invariant.none + ) + else + Invariant.none + in + let priv_vars = + if keep_global then + Priv.invariant_vars ask (priv_getg ctx.global) ctx.local + else + [] in - let priv_vars = Priv.invariant_vars ask (priv_getg ctx.global) ctx.local in let priv_invariant = List.fold_left (fun acc v -> Invariant.(var_invariant v && acc) @@ -1222,7 +1241,10 @@ struct ) else ( CPA.fold (fun k v a -> - Invariant.(a && var_invariant k) + if var_filter k then + Invariant.(a && var_invariant k) + else + a ) cpa Invariant.none ) ) @@ -1230,7 +1252,7 @@ struct Lval.Set.fold (fun k a -> let i = match k with - | (Var v, offset) when not (InvariantCil.var_is_heap v) -> + | (Var v, offset) when var_filter v && not (InvariantCil.var_is_heap v) -> (try I.key_invariant_lval v ~offset ~lval:k (Arg.find v) with Not_found -> Invariant.none) | _ -> Invariant.none in @@ -1245,7 +1267,7 @@ struct Invariant.none let query_invariant_global ctx g = - if GobConfig.get_bool "ana.base.invariant.enabled" then ( + if GobConfig.get_bool "ana.base.invariant.enabled" && GobConfig.get_bool "ana.base.invariant.global" then ( (* Currently these global invariants are only sound with earlyglobs enabled for both single- and multi-threaded programs. Otherwise, the values of globals in single-threaded mode are not accounted for. They are also made sound without earlyglobs using the multithreaded mode ghost variable. *) diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 16c9d7e8ef..7121713c33 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -795,6 +795,18 @@ "type": "boolean", "default": true }, + "local": { + "title": "ana.base.invariant.local", + "description": "Keep local variables in invariants", + "type": "boolean", + "default": true + }, + "global": { + "title": "ana.base.invariant.global", + "description": "Keep global variables in invariants", + "type": "boolean", + "default": true + }, "blobs": { "title": "ana.base.invariant.blobs", "description": "Whether to dump assertions about all blobs. Enabling this option may lead to unsound asserts.", From fbc9e62c8c4ca209759fa2be86ba393c64b51cf4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Aug 2024 11:58:02 +0300 Subject: [PATCH 081/157] Add option ana.var_eq.invariant.enabled --- src/analyses/varEq.ml | 2 +- src/config/options.schema.json | 20 ++++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index 8ece99d6e8..db1228a3dd 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -564,7 +564,7 @@ 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 "ana.var_eq.invariant.enabled" && GobConfig.get_bool "witness.invariant.exact" -> (* only exact equalities here *) let scope = Node.find_fundec ctx.node in D.invariant ~scope ctx.local | _ -> Queries.Result.top x diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 7121713c33..d9174b9aa1 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -1154,6 +1154,26 @@ } }, "additionalProperties": false + }, + "var_eq": { + "title": "ana.var_eq", + "type": "object", + "properties": { + "invariant": { + "title": "ana.var_eq.invariant", + "type": "object", + "properties": { + "enabled": { + "title": "ana.var_eq.invariant.enabled", + "description": "Generate var_eq analysis invariants", + "type": "boolean", + "default": true + } + }, + "additionalProperties": false + } + }, + "additionalProperties": false } }, "additionalProperties": false From 58aaf53abd7f0d73cd525648256670da1caf2c9e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Aug 2024 12:10:11 +0300 Subject: [PATCH 082/157] Update svcomp-ghost conf --- conf/svcomp-ghost.json | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json index 108b261322..dc611695dc 100644 --- a/conf/svcomp-ghost.json +++ b/conf/svcomp-ghost.json @@ -71,6 +71,27 @@ "base": { "arrays": { "domain": "partitioned" + }, + "invariant": { + "local": false, + "global": true + } + }, + "relation": { + "invariant": { + "local": false, + "global": true, + "one-var": false + } + }, + "apron": { + "invariant": { + "diff-box": true + } + }, + "var_eq": { + "invariant": { + "enabled": false } }, "race": { @@ -123,10 +144,10 @@ ] }, "invariant": { - "loop-head": true, + "loop-head": false, "after-lock": true, - "other": true, - "accessed": true, + "other": false, + "accessed": false, "exact": true, "all-locals": false, "flow_insensitive-as-location": true, From f20ed620a1db2acd88b002b096294d8836ed4c55 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 8 Aug 2024 10:58:13 +0300 Subject: [PATCH 083/157] Re-enable witness.invariant.{loop-head,other} in svcomp-ghost conf for flow-insensitive location invariants to work --- conf/svcomp-ghost.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json index dc611695dc..ce308c5e52 100644 --- a/conf/svcomp-ghost.json +++ b/conf/svcomp-ghost.json @@ -144,9 +144,9 @@ ] }, "invariant": { - "loop-head": false, + "loop-head": true, "after-lock": true, - "other": false, + "other": true, "accessed": false, "exact": true, "all-locals": false, From 9c604183f6bd7765fba521dbb7da7efcb9cdf129 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 20 Aug 2024 11:37:34 +0300 Subject: [PATCH 084/157] Add YAML witness ghost_instrumentation entry type --- src/config/options.schema.json | 3 +- src/witness/yamlWitness.ml | 25 +++++++++ src/witness/yamlWitnessType.ml | 99 ++++++++++++++++++++++++++++++++++ tests/util/yamlWitnessStrip.ml | 5 ++ 4 files changed, 131 insertions(+), 1 deletion(-) diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 424992c3de..06b6f26359 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -2648,7 +2648,8 @@ "precondition_loop_invariant_certificate", "invariant_set", "ghost_variable", - "ghost_update" + "ghost_update", + "ghost_instrumentation" ] }, "default": [ diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index d3988f8edb..cc435a38ac 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -160,6 +160,31 @@ struct }; metadata = metadata ~task (); } + + let ghost_variable' ~variable ~type_ ~(initial): GhostInstrumentation.Variable.t = { + name = variable; + scope = "global"; + type_; + initial; + } + + let ghost_update' ~variable ~(expression): GhostInstrumentation.Update.t = { + ghost_variable = variable; + expression; + } + + let ghost_location_update' ~location ~(updates): GhostInstrumentation.LocationUpdate.t = { + location; + updates; + } + + let ghost_instrumentation ~task ~variables ~(location_updates): Entry.t = { + entry_type = GhostInstrumentation { + ghost_variables = variables; + ghost_updates = location_updates; + }; + metadata = metadata ~task (); + } end let yaml_entries_to_file yaml_entries file = diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 4bdb730b82..72afbf432b 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -485,6 +485,99 @@ struct {variable; expression; location} end +module GhostInstrumentation = +struct + + module Variable = + struct + type t = { + name: string; + scope: string; + type_: string; + initial: string; + } + [@@deriving eq, ord, hash] + + let to_yaml {name; scope; type_; initial} = + `O [ + ("name", `String name); + ("scope", `String scope); + ("type", `String type_); + ("initial", `String initial); + ] + + let of_yaml y = + let open GobYaml in + let+ name = y |> find "name" >>= to_string + and+ scope = y |> find "scope" >>= to_string + and+ type_ = y |> find "type" >>= to_string + and+ initial = y |> find "initial" >>= to_string in + {name; scope; type_; initial} + end + + module Update = + struct + type t = { + ghost_variable: string; + expression: string; + } + [@@deriving eq, ord, hash] + + let to_yaml {ghost_variable; expression} = + `O [ + ("ghost_variable", `String ghost_variable); + ("expression", `String expression); + ] + + let of_yaml y = + let open GobYaml in + let+ ghost_variable = y |> find "ghost_variable" >>= to_string + and+ expression = y |> find "expression" >>= to_string in + {ghost_variable; expression} + end + + module LocationUpdate = + struct + type t = { + location: Location.t; + updates: Update.t list; + } + [@@deriving eq, ord, hash] + + let to_yaml {location; updates} = + `O [ + ("location", Location.to_yaml location); + ("updates", `A (List.map Update.to_yaml updates)); + ] + + let of_yaml y = + let open GobYaml in + let+ location = y |> find "location" >>= Location.of_yaml + and+ updates = y |> find "updates" >>= list >>= list_map Update.of_yaml in + {location; updates} + end + + type t = { + ghost_variables: Variable.t list; + ghost_updates: LocationUpdate.t list; + } + [@@deriving eq, ord, hash] + + let entry_type = "ghost_instrumentation" + + let to_yaml' {ghost_variables; ghost_updates} = + [ + ("ghost_variables", `A (List.map Variable.to_yaml ghost_variables)); + ("ghost_updates", `A (List.map LocationUpdate.to_yaml ghost_updates)); + ] + + let of_yaml y = + let open GobYaml in + let+ ghost_variables = y |> find "ghost_variables" >>= list >>= list_map Variable.of_yaml + and+ ghost_updates = y |> find "ghost_updates" >>= list >>= list_map LocationUpdate.of_yaml in + {ghost_variables; ghost_updates} +end + (* TODO: could maybe use GADT, but adds ugly existential layer to entry type pattern matching *) module EntryType = struct @@ -498,6 +591,7 @@ struct | InvariantSet of InvariantSet.t | GhostVariable of GhostVariable.t | GhostUpdate of GhostUpdate.t + | GhostInstrumentation of GhostInstrumentation.t [@@deriving eq, ord, hash] let entry_type = function @@ -510,6 +604,7 @@ struct | InvariantSet _ -> InvariantSet.entry_type | GhostVariable _ -> GhostVariable.entry_type | GhostUpdate _ -> GhostUpdate.entry_type + | GhostInstrumentation _ -> GhostInstrumentation.entry_type let to_yaml' = function | LocationInvariant x -> LocationInvariant.to_yaml' x @@ -521,6 +616,7 @@ struct | InvariantSet x -> InvariantSet.to_yaml' x | GhostVariable x -> GhostVariable.to_yaml' x | GhostUpdate x -> GhostUpdate.to_yaml' x + | GhostInstrumentation x -> GhostInstrumentation.to_yaml' x let of_yaml y = let open GobYaml in @@ -552,6 +648,9 @@ struct else if entry_type = GhostUpdate.entry_type then let+ x = y |> GhostUpdate.of_yaml in GhostUpdate x + else if entry_type = GhostInstrumentation.entry_type then + let+ x = y |> GhostInstrumentation.of_yaml in + GhostInstrumentation x else Error (`Msg ("entry_type " ^ entry_type)) end diff --git a/tests/util/yamlWitnessStrip.ml b/tests/util/yamlWitnessStrip.ml index 211a8a0e1a..4d7b446bab 100644 --- a/tests/util/yamlWitnessStrip.ml +++ b/tests/util/yamlWitnessStrip.ml @@ -26,6 +26,9 @@ struct in {invariant_type} in + let ghost_location_update_strip_file_hash (x: GhostInstrumentation.LocationUpdate.t): GhostInstrumentation.LocationUpdate.t = + {x with location = location_strip_file_hash x.location} + in let entry_type: EntryType.t = match entry_type with | LocationInvariant x -> @@ -46,6 +49,8 @@ struct GhostVariable x (* no location to strip *) | GhostUpdate x -> GhostUpdate {x with location = location_strip_file_hash x.location} + | GhostInstrumentation x -> + GhostInstrumentation {x with ghost_updates = List.map ghost_location_update_strip_file_hash x.ghost_updates} in {entry_type} From d22065396f057689adf10ee950d623fb999bc4b7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 20 Aug 2024 12:27:58 +0300 Subject: [PATCH 085/157] Add ghost_instrumentation support to mutexGhosts --- src/analyses/mutexGhosts.ml | 84 ++++++++++++++++++++-- src/witness/witnessGhost.ml | 22 +++++- tests/regression/13-privatized/74-mutex.t | 87 +++++++++++++++++++++++ 3 files changed, 186 insertions(+), 7 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 7bc4423f04..09afc41baa 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -10,17 +10,19 @@ struct include UnitAnalysis.Spec let name () = "mutexGhosts" - module ThreadCreate = Printable.UnitConf (struct let name = "threadcreate" end) + (* module ThreadCreate = Printable.UnitConf (struct let name = "threadcreate" end) *) module V = struct - include Printable.Either3 (Node) (LockDomain.MustLock) (ThreadCreate) + include Printable.Either3 (Node) (LockDomain.MustLock) (BoolDomain.Bool) let node x = `Left x let lock x = `Middle x - let threadcreate = `Right () + let threadcreate = `Right false + let update = `Right true let is_write_only = function | `Left _ -> false | `Middle _ -> true - | `Right _ -> false + | `Right false -> false + | `Right true -> true end module Locked = @@ -53,9 +55,11 @@ struct | `Bot -> NodeSet.bot () | `Lifted2 (`Lifted2 x) -> x | _ -> failwith "MutexGhosts.threadcreate" + let update = threadcreate let create_node node = `Lifted1 node let create_lock lock = `Lifted2 (`Lifted1 lock) let create_threadcreate threadcreate = `Lifted2 (`Lifted2 threadcreate) + let create_update = create_threadcreate end let mustlock_of_addr (addr: LockDomain.Addr.t): LockDomain.MustLock.t option = @@ -69,6 +73,7 @@ struct | Events.Lock (l, _) when not (LockDomain.Addr.equal l verifier_atomic_addr) -> ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.singleton l, Unlocked.bot (), MultiThread.bot ())); if !AnalysisState.postsolving then ( + ctx.sideg V.update (G.create_update (NodeSet.singleton ctx.prev_node)); let (locked, _, _) = G.node (ctx.global (V.node ctx.prev_node)) in if Locked.cardinal locked > 1 then ( Locked.iter (fun lock -> @@ -81,6 +86,7 @@ struct | Events.Unlock l when not (LockDomain.Addr.equal l verifier_atomic_addr) -> ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.singleton l, MultiThread.bot ())); if !AnalysisState.postsolving then ( + ctx.sideg V.update (G.create_update (NodeSet.singleton ctx.prev_node)); let (_, unlocked, _) = G.node (ctx.global (V.node ctx.prev_node)) in if Locked.cardinal unlocked > 1 then ( Locked.iter (fun lock -> @@ -91,7 +97,9 @@ struct ); ) | Events.EnterMultiThreaded -> - ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true)) + ctx.sideg (V.node ctx.prev_node) (G.create_node (Locked.bot (), Unlocked.bot (), true)); + if !AnalysisState.postsolving then + ctx.sideg V.update (G.create_update (NodeSet.singleton ctx.prev_node)); | _ -> () end; ctx.local @@ -113,7 +121,7 @@ struct | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in begin match g with - | `Left g' -> + | `Left g' when YamlWitness.entry_type_enabled YamlWitnessType.GhostVariable.entry_type && YamlWitness.entry_type_enabled YamlWitnessType.GhostUpdate.entry_type -> let (locked, unlocked, multithread) = G.node (ctx.global g) in let g = g' in let entries = @@ -161,6 +169,70 @@ struct entries in entries + | `Right true when YamlWitness.entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type -> + let nodes = G.update (ctx.global g) in + let (variables, location_updates) = NodeSet.fold (fun node (variables, location_updates) -> + let (locked, unlocked, multithread) = G.node (ctx.global (V.node node)) in + let variables' = + (* TODO: do variable_entry-s only once *) + Locked.fold (fun l acc -> + match mustlock_of_addr l with + | Some l when ghost_var_available ctx (Locked l) -> + let variable = WitnessGhost.variable' (Locked l) in + if BatList.mem_cmp YamlWitnessType.GhostInstrumentation.Variable.compare variable acc then (* TODO: be efficient *) + acc + else + variable :: acc + | _ -> + acc + ) (Locked.union locked unlocked) variables + in + let updates = + Locked.fold (fun l acc -> + match mustlock_of_addr l with + | Some l when ghost_var_available ctx (Locked l) -> + let update = WitnessGhost.update' (Locked l) GoblintCil.one in + update :: acc + | _ -> + acc + ) locked [] + in + let updates = + Unlocked.fold (fun l acc -> + match mustlock_of_addr l with + | Some l when ghost_var_available ctx (Locked l) -> + let update = WitnessGhost.update' (Locked l) GoblintCil.zero in + update :: acc + | _ -> + acc + ) unlocked updates + in + let (variables', updates) = + if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( + if ghost_var_available ctx Multithreaded then ( + let variable = WitnessGhost.variable' Multithreaded in + let update = WitnessGhost.update' Multithreaded GoblintCil.one in + let variables' = + if BatList.mem_cmp YamlWitnessType.GhostInstrumentation.Variable.compare variable variables' then (* TODO: be efficient *) + variables' + else + variable :: variables' + in + (variables', update :: updates) + ) + else + (variables', updates) + ) + else + (variables', updates) + in + let location_update = WitnessGhost.location_update' ~node ~updates in + (variables', location_update :: location_updates) + ) nodes ([], []) + in + let entry = WitnessGhost.instrumentation_entry ~task ~variables ~location_updates in + Queries.YS.singleton entry + | `Left _ -> Queries.Result.top q | `Middle _ -> Queries.Result.top q | `Right _ -> Queries.Result.top q end diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index 91d513ceae..3535e8a347 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -1,7 +1,7 @@ (** Ghost variables for YAML witnesses. *) let enabled () = - YamlWitness.entry_type_enabled YamlWitnessType.GhostVariable.entry_type && YamlWitness.entry_type_enabled YamlWitnessType.GhostUpdate.entry_type + (YamlWitness.entry_type_enabled YamlWitnessType.GhostVariable.entry_type && YamlWitness.entry_type_enabled YamlWitnessType.GhostUpdate.entry_type) || YamlWitness.entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type module Var = WitnessGhostVar @@ -24,3 +24,23 @@ let update_entry ~task ~node x e = let variable = name_varinfo x in let expression = CilType.Exp.show e in YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression + +let variable' x = + let variable = name_varinfo x in + let type_ = String.trim (CilType.Typ.show (typ x)) in (* CIL printer puts space at the end of some types *) + let initial = CilType.Exp.show (initial x) in + YamlWitness.Entry.ghost_variable' ~variable ~type_ ~initial + +let update' x e = + let variable = name_varinfo x in + let expression = CilType.Exp.show e in + YamlWitness.Entry.ghost_update' ~variable ~expression + +let location_update' ~node ~updates = + let loc = Node.location node in + let location_function = (Node.find_fundec node).svar.vname in + let location = YamlWitness.Entry.location ~location:loc ~location_function in + YamlWitness.Entry.ghost_location_update' ~location ~updates + +let instrumentation_entry ~task ~variables ~location_updates = + YamlWitness.Entry.ghost_instrumentation ~task ~variables ~location_updates diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 8999d394ec..eec046bcb6 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -148,6 +148,93 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm unsafe: 0 total memory locations: 1 +Same with ghost_instrumentation entry. + + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 74-mutex.c + [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) + [Warning][Deadcode] Function 'producer' has dead code: + on line 26 (74-mutex.c:26-26) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 14 + dead: 1 + total lines: 15 + [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) + [Info][Witness] witness generation summary: + total generation entries: 3 + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_instrumentation + ghost_variables: + - name: multithreaded + scope: global + type: int + initial: "0" + - name: m_locked + scope: global + type: int + initial: "0" + ghost_updates: + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 38 + column: 3 + function: main + updates: + - ghost_variable: m_locked + expression: "0" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 3 + function: main + updates: + - ghost_variable: m_locked + expression: "1" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 34 + column: 3 + function: main + updates: + - ghost_variable: multithreaded + expression: "1" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 23 + column: 5 + function: producer + updates: + - ghost_variable: m_locked + expression: "0" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 20 + column: 5 + function: producer + updates: + - ghost_variable: m_locked + expression: "1" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m_locked || used == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= used && used <= 1)' + type: assertion + format: C + Same with mutex-meet. $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c From f79ad180cc9bb3ff2b00b73fcda4368718b8f307 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 20 Aug 2024 12:53:28 +0300 Subject: [PATCH 086/157] Add option for emitting flow_insensitive_invariant-s as invariant_set location_invariant-s in YAML witnesses --- conf/svcomp-ghost.json | 2 +- src/config/options.schema.json | 9 ++-- src/witness/yamlWitness.ml | 52 ++++++++++++++++--- .../regression/13-privatized/04-priv_multi.t | 2 +- tests/regression/13-privatized/74-mutex.t | 40 +++++++++----- 5 files changed, 77 insertions(+), 28 deletions(-) diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json index ce308c5e52..c4f165960d 100644 --- a/conf/svcomp-ghost.json +++ b/conf/svcomp-ghost.json @@ -150,7 +150,7 @@ "accessed": false, "exact": true, "all-locals": false, - "flow_insensitive-as-location": true, + "flow_insensitive-as": "location_invariant", "exclude-vars": [ "tmp\\(___[0-9]+\\)?", "cond", diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 06b6f26359..11df177cd3 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -2604,11 +2604,12 @@ "type": "boolean", "default": true }, - "flow_insensitive-as-location": { - "title": "witness.invariant.flow_insensitive-as-location", + "flow_insensitive-as": { + "title": "witness.invariant.flow_insensitive-as", "description": "Emit flow-insensitive invariants as location invariants at certain locations.", - "type": "boolean", - "default": false + "type": "string", + "enum": ["flow_insensitive_invariant", "location_invariant", "invariant_set-location_invariant"], + "default": "flow_insensitive_invariant" } }, "additionalProperties": false diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index cc435a38ac..c8217bde19 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -347,22 +347,23 @@ struct entries in + let invariant_global_nodes = lazy (R.ask_global InvariantGlobalNodes) in + (* Generate flow-insensitive invariants *) let entries = if entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type then ( - let ns = lazy (R.ask_global InvariantGlobalNodes) in GHT.fold (fun g v acc -> match g with | `Left g -> (* Spec global *) - begin match R.ask_global (InvariantGlobal (Obj.repr g)), GobConfig.get_bool "witness.invariant.flow_insensitive-as-location" with - | `Lifted inv, false -> + begin match R.ask_global (InvariantGlobal (Obj.repr g)), GobConfig.get_string "witness.invariant.flow_insensitive-as" with + | `Lifted inv, "flow_insensitive_invariant" -> let invs = WitnessUtil.InvariantExp.process_exp inv in List.fold_left (fun acc inv -> let invariant = Entry.invariant (CilType.Exp.show inv) in let entry = Entry.flow_insensitive_invariant ~task ~invariant in entry :: acc ) acc invs - | `Lifted inv, true -> + | `Lifted inv, "location_invariant" -> (* TODO: or do at location_invariant loop for each node and query if should also do global invariants there? *) let invs = WitnessUtil.InvariantExp.process_exp inv in Queries.NS.fold (fun n acc -> @@ -377,7 +378,8 @@ struct entry :: acc ) acc invs | None -> acc - ) (Lazy.force ns) acc + ) (Lazy.force invariant_global_nodes) acc + | `Lifted _, _ | `Bot, _ | `Top, _ -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc end @@ -516,12 +518,12 @@ struct (* Generate invariant set *) let entries = - if entry_type_enabled YamlWitnessType.InvariantSet.entry_type then ( + if entry_type_enabled YamlWitnessType.InvariantSet.entry_type || entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type && GobConfig.get_string "witness.invariant.flow_insensitive-as" = "invariant_set-location_invariant" then ( let invariants = [] in (* Generate location invariants *) let invariants = - if invariant_type_enabled YamlWitnessType.InvariantSet.LocationInvariant.invariant_type then ( + if entry_type_enabled YamlWitnessType.InvariantSet.entry_type && invariant_type_enabled YamlWitnessType.InvariantSet.LocationInvariant.invariant_type then ( LH.fold (fun loc ns acc -> let inv = List.fold_left (fun acc n -> let local = try NH.find (Lazy.force nh) n with Not_found -> Spec.D.bot () in @@ -550,7 +552,7 @@ struct (* Generate loop invariants *) let invariants = - if invariant_type_enabled YamlWitnessType.InvariantSet.LoopInvariant.invariant_type then ( + if entry_type_enabled YamlWitnessType.InvariantSet.entry_type && invariant_type_enabled YamlWitnessType.InvariantSet.LoopInvariant.invariant_type then ( LH.fold (fun loc ns acc -> if WitnessInvariant.emit_loop_head then ( (* TODO: remove double condition? *) let inv = List.fold_left (fun acc n -> @@ -580,6 +582,40 @@ struct invariants in + (* Generate flow-insensitive invariants as location invariants *) + let invariants = + if entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type && GobConfig.get_string "witness.invariant.flow_insensitive-as" = "invariant_set-location_invariant" then ( + GHT.fold (fun g v acc -> + match g with + | `Left g -> (* Spec global *) + begin match R.ask_global (InvariantGlobal (Obj.repr g)) with + | `Lifted inv -> + (* TODO: or do at location_invariant loop for each node and query if should also do global invariants there? *) + let invs = WitnessUtil.InvariantExp.process_exp inv in + Queries.NS.fold (fun n acc -> + let fundec = Node.find_fundec n in + match WitnessInvariant.location_location n with (* if after thread create node happens to be loop node *) + | Some loc -> + let location_function = fundec.svar.vname in + let location = Entry.location ~location:loc ~location_function in + List.fold_left (fun acc inv -> + let invariant = CilType.Exp.show inv in + let invariant = Entry.location_invariant' ~location ~invariant in + invariant :: acc + ) acc invs + | None -> acc + ) (Lazy.force invariant_global_nodes) acc + | `Bot | `Top -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) + acc + end + | `Right _ -> (* contexts global *) + acc + ) gh invariants + ) + else + invariants + in + let invariants = List.rev invariants in let entry = Entry.invariant_set ~task ~invariants in entry :: entries diff --git a/tests/regression/13-privatized/04-priv_multi.t b/tests/regression/13-privatized/04-priv_multi.t index b1a45dd917..fd0dad6a39 100644 --- a/tests/regression/13-privatized/04-priv_multi.t +++ b/tests/regression/13-privatized/04-priv_multi.t @@ -174,7 +174,7 @@ Flow-insensitive invariants as location invariants. - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 04-priv_multi.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --set witness.invariant.flow_insensitive-as location_invariant 04-priv_multi.c [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) [Warning][Deadcode] Function 'dispose' has dead code: diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index eec046bcb6..c99cdb6ff9 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -84,7 +84,7 @@ Flow-insensitive invariants as location invariants. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --enable witness.invariant.flow_insensitive-as-location 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --set witness.invariant.flow_insensitive-as location_invariant 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -148,9 +148,9 @@ Earlyglobs shouldn't cause protected writes in multithreaded mode from being imm unsafe: 0 total memory locations: 1 -Same with ghost_instrumentation entry. +Same with ghost_instrumentation and invariant_set entries. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' --set witness.invariant.flow_insensitive-as invariant_set-location_invariant 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -160,7 +160,7 @@ Same with ghost_instrumentation entry. total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: - total generation entries: 3 + total generation entries: 2 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -224,16 +224,28 @@ Same with ghost_instrumentation entry. updates: - ghost_variable: m_locked expression: "1" - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (m_locked || used == 0)' - type: assertion - format: C - - entry_type: flow_insensitive_invariant - flow_insensitive_invariant: - string: '! multithreaded || (0 <= used && used <= 1)' - type: assertion - format: C + - entry_type: invariant_set + content: + - invariant: + type: location_invariant + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 3 + function: main + value: '! multithreaded || (m_locked || used == 0)' + format: c_expression + - invariant: + type: location_invariant + location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 3 + function: main + value: '! multithreaded || (0 <= used && used <= 1)' + format: c_expression Same with mutex-meet. From e9e652d86cac07bdff43780fbe5467fe46870265 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 20 Aug 2024 12:56:26 +0300 Subject: [PATCH 087/157] Use invariant_set in svcomp-ghost conf --- conf/svcomp-ghost.json | 7 +++---- src/config/options.schema.json | 3 ++- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/conf/svcomp-ghost.json b/conf/svcomp-ghost.json index c4f165960d..cb4d8f1384 100644 --- a/conf/svcomp-ghost.json +++ b/conf/svcomp-ghost.json @@ -136,11 +136,10 @@ }, "yaml": { "enabled": true, - "format-version": "0.1", + "format-version": "2.1", "entry-types": [ "flow_insensitive_invariant", - "ghost_variable", - "ghost_update" + "ghost_instrumentation" ] }, "invariant": { @@ -150,7 +149,7 @@ "accessed": false, "exact": true, "all-locals": false, - "flow_insensitive-as": "location_invariant", + "flow_insensitive-as": "invariant_set-location_invariant", "exclude-vars": [ "tmp\\(___[0-9]+\\)?", "cond", diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 11df177cd3..1101e04ace 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -2630,7 +2630,8 @@ "type": "string", "enum": [ "0.1", - "2.0" + "2.0", + "2.1" ], "default": "0.1" }, From 431b34d18d12ef588c67a170f4a139665e73720c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 20 Aug 2024 15:02:07 +0300 Subject: [PATCH 088/157] Make invariant_set and ghost_instrumentation deterministic in tests --- tests/regression/13-privatized/74-mutex.t | 40 +++++++++++------------ tests/util/yamlWitnessStrip.ml | 12 +++++-- 2 files changed, 29 insertions(+), 23 deletions(-) diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index c99cdb6ff9..0c2947ab37 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -170,11 +170,11 @@ Same with ghost_instrumentation and invariant_set entries. $ yamlWitnessStrip < witness.yml - entry_type: ghost_instrumentation ghost_variables: - - name: multithreaded + - name: m_locked scope: global type: int initial: "0" - - name: m_locked + - name: multithreaded scope: global type: int initial: "0" @@ -182,21 +182,21 @@ Same with ghost_instrumentation and invariant_set entries. - location: file_name: 74-mutex.c file_hash: $FILE_HASH - line: 38 - column: 3 - function: main + line: 20 + column: 5 + function: producer updates: - ghost_variable: m_locked - expression: "0" + expression: "1" - location: file_name: 74-mutex.c file_hash: $FILE_HASH - line: 36 - column: 3 - function: main + line: 23 + column: 5 + function: producer updates: - ghost_variable: m_locked - expression: "1" + expression: "0" - location: file_name: 74-mutex.c file_hash: $FILE_HASH @@ -209,21 +209,21 @@ Same with ghost_instrumentation and invariant_set entries. - location: file_name: 74-mutex.c file_hash: $FILE_HASH - line: 23 - column: 5 - function: producer + line: 36 + column: 3 + function: main updates: - ghost_variable: m_locked - expression: "0" + expression: "1" - location: file_name: 74-mutex.c file_hash: $FILE_HASH - line: 20 - column: 5 - function: producer + line: 38 + column: 3 + function: main updates: - ghost_variable: m_locked - expression: "1" + expression: "0" - entry_type: invariant_set content: - invariant: @@ -234,7 +234,7 @@ Same with ghost_instrumentation and invariant_set entries. line: 36 column: 3 function: main - value: '! multithreaded || (m_locked || used == 0)' + value: '! multithreaded || (0 <= used && used <= 1)' format: c_expression - invariant: type: location_invariant @@ -244,7 +244,7 @@ Same with ghost_instrumentation and invariant_set entries. line: 36 column: 3 function: main - value: '! multithreaded || (0 <= used && used <= 1)' + value: '! multithreaded || (m_locked || used == 0)' format: c_expression Same with mutex-meet. diff --git a/tests/util/yamlWitnessStrip.ml b/tests/util/yamlWitnessStrip.ml index 4d7b446bab..dff8bfb0cf 100644 --- a/tests/util/yamlWitnessStrip.ml +++ b/tests/util/yamlWitnessStrip.ml @@ -27,7 +27,10 @@ struct {invariant_type} in let ghost_location_update_strip_file_hash (x: GhostInstrumentation.LocationUpdate.t): GhostInstrumentation.LocationUpdate.t = - {x with location = location_strip_file_hash x.location} + { + location = location_strip_file_hash x.location; + updates = List.sort GhostInstrumentation.Update.compare x.updates + } in let entry_type: EntryType.t = match entry_type with @@ -44,13 +47,16 @@ struct | PreconditionLoopInvariantCertificate x -> PreconditionLoopInvariantCertificate {x with target = target_strip_file_hash x.target} | InvariantSet x -> - InvariantSet {content = List.map invariant_strip_file_hash x.content} + InvariantSet {content = List.sort InvariantSet.Invariant.compare (List.map invariant_strip_file_hash x.content)} (* Sort, so order is deterministic regardless of Goblint. *) | GhostVariable x -> GhostVariable x (* no location to strip *) | GhostUpdate x -> GhostUpdate {x with location = location_strip_file_hash x.location} | GhostInstrumentation x -> - GhostInstrumentation {x with ghost_updates = List.map ghost_location_update_strip_file_hash x.ghost_updates} + GhostInstrumentation { (* Sort, so order is deterministic regardless of Goblint. *) + ghost_variables = List.sort GhostInstrumentation.Variable.compare x.ghost_variables; + ghost_updates = List.sort GhostInstrumentation.LocationUpdate.compare (List.map ghost_location_update_strip_file_hash x.ghost_updates); + } in {entry_type} From 2c9955048a13c162fcf74f7ccd67d614c73e3ee5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Aug 2024 17:25:23 +0300 Subject: [PATCH 089/157] Remove ghost_ prefix from ghost_instrumentation update entries --- src/witness/yamlWitness.ml | 2 +- src/witness/yamlWitnessType.ml | 10 +++++----- tests/regression/13-privatized/74-mutex.t | 10 +++++----- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index c8217bde19..c917361d9b 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -169,7 +169,7 @@ struct } let ghost_update' ~variable ~(expression): GhostInstrumentation.Update.t = { - ghost_variable = variable; + variable; expression; } diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 72afbf432b..cefb0866f3 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -518,22 +518,22 @@ struct module Update = struct type t = { - ghost_variable: string; + variable: string; expression: string; } [@@deriving eq, ord, hash] - let to_yaml {ghost_variable; expression} = + let to_yaml {variable; expression} = `O [ - ("ghost_variable", `String ghost_variable); + ("variable", `String variable); ("expression", `String expression); ] let of_yaml y = let open GobYaml in - let+ ghost_variable = y |> find "ghost_variable" >>= to_string + let+ variable = y |> find "variable" >>= to_string and+ expression = y |> find "expression" >>= to_string in - {ghost_variable; expression} + {variable; expression} end module LocationUpdate = diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 0c2947ab37..9a11b6846f 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -186,7 +186,7 @@ Same with ghost_instrumentation and invariant_set entries. column: 5 function: producer updates: - - ghost_variable: m_locked + - variable: m_locked expression: "1" - location: file_name: 74-mutex.c @@ -195,7 +195,7 @@ Same with ghost_instrumentation and invariant_set entries. column: 5 function: producer updates: - - ghost_variable: m_locked + - variable: m_locked expression: "0" - location: file_name: 74-mutex.c @@ -204,7 +204,7 @@ Same with ghost_instrumentation and invariant_set entries. column: 3 function: main updates: - - ghost_variable: multithreaded + - variable: multithreaded expression: "1" - location: file_name: 74-mutex.c @@ -213,7 +213,7 @@ Same with ghost_instrumentation and invariant_set entries. column: 3 function: main updates: - - ghost_variable: m_locked + - variable: m_locked expression: "1" - location: file_name: 74-mutex.c @@ -222,7 +222,7 @@ Same with ghost_instrumentation and invariant_set entries. column: 3 function: main updates: - - ghost_variable: m_locked + - variable: m_locked expression: "0" - entry_type: invariant_set content: From 12dadf4f03c8ff9d3e4a1546235722066018fd40 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 2 Sep 2024 11:03:57 +0300 Subject: [PATCH 090/157] Wrap ghost_instrumentation in content --- src/witness/yamlWitnessType.ml | 13 ++- tests/regression/13-privatized/74-mutex.t | 111 +++++++++++----------- 2 files changed, 64 insertions(+), 60 deletions(-) diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index cefb0866f3..b04a2c35bf 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -566,15 +566,18 @@ struct let entry_type = "ghost_instrumentation" let to_yaml' {ghost_variables; ghost_updates} = - [ - ("ghost_variables", `A (List.map Variable.to_yaml ghost_variables)); - ("ghost_updates", `A (List.map LocationUpdate.to_yaml ghost_updates)); + [("content", + `O [ + ("ghost_variables", `A (List.map Variable.to_yaml ghost_variables)); + ("ghost_updates", `A (List.map LocationUpdate.to_yaml ghost_updates)); + ]) ] let of_yaml y = let open GobYaml in - let+ ghost_variables = y |> find "ghost_variables" >>= list >>= list_map Variable.of_yaml - and+ ghost_updates = y |> find "ghost_updates" >>= list >>= list_map LocationUpdate.of_yaml in + let* content = y |> find "content" in + let+ ghost_variables = content |> find "ghost_variables" >>= list >>= list_map Variable.of_yaml + and+ ghost_updates = content |> find "ghost_updates" >>= list >>= list_map LocationUpdate.of_yaml in {ghost_variables; ghost_updates} end diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 9a11b6846f..478921155e 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -169,61 +169,62 @@ Same with ghost_instrumentation and invariant_set entries. $ yamlWitnessStrip < witness.yml - entry_type: ghost_instrumentation - ghost_variables: - - name: m_locked - scope: global - type: int - initial: "0" - - name: multithreaded - scope: global - type: int - initial: "0" - ghost_updates: - - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 20 - column: 5 - function: producer - updates: - - variable: m_locked - expression: "1" - - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 23 - column: 5 - function: producer - updates: - - variable: m_locked - expression: "0" - - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 34 - column: 3 - function: main - updates: - - variable: multithreaded - expression: "1" - - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 36 - column: 3 - function: main - updates: - - variable: m_locked - expression: "1" - - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 38 - column: 3 - function: main - updates: - - variable: m_locked - expression: "0" + content: + ghost_variables: + - name: m_locked + scope: global + type: int + initial: "0" + - name: multithreaded + scope: global + type: int + initial: "0" + ghost_updates: + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 20 + column: 5 + function: producer + updates: + - variable: m_locked + expression: "1" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 23 + column: 5 + function: producer + updates: + - variable: m_locked + expression: "0" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 34 + column: 3 + function: main + updates: + - variable: multithreaded + expression: "1" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 3 + function: main + updates: + - variable: m_locked + expression: "1" + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 38 + column: 3 + function: main + updates: + - variable: m_locked + expression: "0" - entry_type: invariant_set content: - invariant: From 852297b68abbcb05c3f3700098e2bc2f22c93333 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 2 Sep 2024 11:10:31 +0300 Subject: [PATCH 091/157] Add value and format to ghost_instrumentation --- src/witness/yamlWitness.ml | 8 +++-- src/witness/yamlWitnessType.ml | 40 ++++++++++++++++++----- tests/regression/13-privatized/74-mutex.t | 23 +++++++++---- 3 files changed, 54 insertions(+), 17 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index c917361d9b..f8890d8eaa 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -165,12 +165,16 @@ struct name = variable; scope = "global"; type_; - initial; + initial = { + value = initial; + format = "c_expression"; + }; } let ghost_update' ~variable ~(expression): GhostInstrumentation.Update.t = { variable; - expression; + value = expression; + format = "c_expression"; } let ghost_location_update' ~location ~(updates): GhostInstrumentation.LocationUpdate.t = { diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index b04a2c35bf..7834951892 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -488,13 +488,34 @@ end module GhostInstrumentation = struct + module Initial = + struct + type t = { + value: string; + format: string; + } + [@@deriving eq, ord, hash] + + let to_yaml {value; format} = + `O [ + ("value", `String value); + ("format", `String format); + ] + + let of_yaml y = + let open GobYaml in + let+ value = y |> find "value" >>= to_string + and+ format = y |> find "format" >>= to_string in + {value; format} + end + module Variable = struct type t = { name: string; scope: string; type_: string; - initial: string; + initial: Initial.t; } [@@deriving eq, ord, hash] @@ -503,7 +524,7 @@ struct ("name", `String name); ("scope", `String scope); ("type", `String type_); - ("initial", `String initial); + ("initial", Initial.to_yaml initial); ] let of_yaml y = @@ -511,7 +532,7 @@ struct let+ name = y |> find "name" >>= to_string and+ scope = y |> find "scope" >>= to_string and+ type_ = y |> find "type" >>= to_string - and+ initial = y |> find "initial" >>= to_string in + and+ initial = y |> find "initial" >>= Initial.of_yaml in {name; scope; type_; initial} end @@ -519,21 +540,24 @@ struct struct type t = { variable: string; - expression: string; + value: string; + format: string; } [@@deriving eq, ord, hash] - let to_yaml {variable; expression} = + let to_yaml {variable; value; format} = `O [ ("variable", `String variable); - ("expression", `String expression); + ("value", `String value); + ("format", `String format); ] let of_yaml y = let open GobYaml in let+ variable = y |> find "variable" >>= to_string - and+ expression = y |> find "expression" >>= to_string in - {variable; expression} + and+ value = y |> find "value" >>= to_string + and+ format = y |> find "format" >>= to_string in + {variable; value; format} end module LocationUpdate = diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 478921155e..8a1a7fee5f 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -174,11 +174,15 @@ Same with ghost_instrumentation and invariant_set entries. - name: m_locked scope: global type: int - initial: "0" + initial: + value: "0" + format: c_expression - name: multithreaded scope: global type: int - initial: "0" + initial: + value: "0" + format: c_expression ghost_updates: - location: file_name: 74-mutex.c @@ -188,7 +192,8 @@ Same with ghost_instrumentation and invariant_set entries. function: producer updates: - variable: m_locked - expression: "1" + value: "1" + format: c_expression - location: file_name: 74-mutex.c file_hash: $FILE_HASH @@ -197,7 +202,8 @@ Same with ghost_instrumentation and invariant_set entries. function: producer updates: - variable: m_locked - expression: "0" + value: "0" + format: c_expression - location: file_name: 74-mutex.c file_hash: $FILE_HASH @@ -206,7 +212,8 @@ Same with ghost_instrumentation and invariant_set entries. function: main updates: - variable: multithreaded - expression: "1" + value: "1" + format: c_expression - location: file_name: 74-mutex.c file_hash: $FILE_HASH @@ -215,7 +222,8 @@ Same with ghost_instrumentation and invariant_set entries. function: main updates: - variable: m_locked - expression: "1" + value: "1" + format: c_expression - location: file_name: 74-mutex.c file_hash: $FILE_HASH @@ -224,7 +232,8 @@ Same with ghost_instrumentation and invariant_set entries. function: main updates: - variable: m_locked - expression: "0" + value: "0" + format: c_expression - entry_type: invariant_set content: - invariant: From 3bb17bc06fd9901d6476a5db72f9af0be805e7e5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 24 Oct 2024 17:24:37 +0300 Subject: [PATCH 092/157] Add cram tests for some solvers --- tests/regression/00-sanity/01-assert.t | 130 +++++++++++++++++++++++++ 1 file changed, 130 insertions(+) diff --git a/tests/regression/00-sanity/01-assert.t b/tests/regression/00-sanity/01-assert.t index 9142f805f9..2f81310ada 100644 --- a/tests/regression/00-sanity/01-assert.t +++ b/tests/regression/00-sanity/01-assert.t @@ -9,3 +9,133 @@ live: 7 dead: 2 total lines: 9 + + +Test ancient solvers: + + $ goblint --enable warn.deterministic --set solver WL 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver effectWConEq 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + +Test topdown solvers: + + $ goblint --enable warn.deterministic --set solver topdown_deprecated 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver topdown 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver topdown_term 01-assert.c + [Error] Fixpoint not reached at L:entry state of main (299) on 01-assert.c:4:1-15:1 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), + mallocWrapper:(wrapper call:Unknown node, unique calls:{}), + base:({ + }, {}, {}, {}), + threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), + threadflag:Singlethreaded, + threadreturn:true, + escape:{}, + mutexEvents:(), + access:(), + mutex:(lockset:{}, multiplicity:{}), + race:(), + mhp:(), + assert:(), + pthreadMutexType:()], map:{})} + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), + mallocWrapper:(wrapper call:Unknown node, unique calls:{}), + base:({ + }, {}, {}, {}), + threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), + threadflag:Singlethreaded, + threadreturn:true, + escape:{}, + mutexEvents:(), + access:(), + mutex:(lockset:{}, multiplicity:{}), + race:(), + mhp:(), + assert:(), + pthreadMutexType:()], map:{})} instead of bot + + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 4..7 (01-assert.c:4-7) + on lines 10..14 (01-assert.c:10-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 0 + dead: 9 + total lines: 9 + [Error][Unsound] Fixpoint not reached + [3] + + $ goblint --enable warn.deterministic --set solver topdown_space_cache_term 01-assert.c + [Error] Cannot find value 'solvers.wp.restore' in + {"files":["01-assert.c"],"outfile":"","justcil":false,"justcfg":false,"verify":true,"mainfun":["main"],"exitfun":[],"otherfun":[],"allglobs":false,"kernel":false,"dump_globs":false,"result":"none","solver":"topdown_space_cache_term","comparesolver":"","allfuns":false,"nonstatic":false,"colors":"auto","g2html":false,"save_run":"","load_run":"","compare_runs":[],"warn_at":"post","gobview":false,"jobs":1,"goblint-dir":".goblint","pre":{"enabled":true,"keep":false,"exist":false,"includes":[],"kernel_includes":[],"custom_includes":[],"kernel-root":"","cppflags":[],"compdb":{"original-path":"","split":false},"transform-paths":true},"cil":{"merge":{"inlines":true},"cstd":"c99","gnu89inline":false,"addNestedScopeAttr":false},"server":{"enabled":false,"mode":"stdio","unix-socket":"goblint.sock","reparse":false},"ana":{"activated":["expRelation","base","threadid","threadflag","threadreturn","escape","mutexEvents","mutex","access","race","mallocWrapper","mhp","assert","pthreadMutexType"],"path_sens":["mutex","malloc_null","uninit","expsplit","activeSetjmp","memLeak","apron","affeq","lin2vareq"],"ctx_insens":["stack_loc","stack_trace_set"],"ctx_sens":[],"setjmp":{"split":"precise"},"int":{"def_exc":true,"interval":false,"interval_set":false,"enums":false,"congruence":false,"refinement":"never","def_exc_widen_by_join":false,"interval_narrow_by_meet":false,"interval_threshold_widening":false,"interval_threshold_widening_constants":"all"},"float":{"interval":false,"evaluate_math_functions":false},"pml":{"debug":true},"opt":{"hashcons":true,"equal":true},"autotune":{"enabled":false,"activated":["congruence","singleThreaded","specification","mallocWrappers","noRecursiveIntervals","enums","loopUnrollHeuristic","arrayDomain","octagon","wideningThresholds","memsafetySpecification","termination","tmpSpecialAnalysis"]},"sv-comp":{"enabled":false,"functions":false},"specification":"","wp":false,"arrayoob":false,"base":{"context":{"non-ptr":true,"int":true,"interval":true,"interval_set":true},"strings":{"domain":"flat"},"partition-arrays":{"keep-expr":"first","partition-by-const-on-return":false,"smart-join":false},"arrays":{"domain":"trivial","unrolling-factor":0,"nullbytes":false},"structs":{"domain":"simple","key":{"forward":true,"avoid-ints":true,"prefer-ptrs":true}},"privatization":"protection-read","priv":{"not-started":true,"must-joined":true},"invariant":{"enabled":true,"blobs":false,"unassume":"once","int":{"simplify":"all"}},"eval":{"deep-query":true}},"malloc":{"wrappers":["kmalloc","__kmalloc","usb_alloc_urb","__builtin_alloca","kzalloc"],"unique_address_count":0},"apron":{"strengthening":false,"domain":"octagon","threshold_widening":false,"threshold_widening_constants":"all","invariant":{"diff-box":false}},"relation":{"context":true,"privatization":"mutex-meet","priv":{"not-started":true,"must-joined":true},"invariant":{"one-var":false,"local":true,"global":true}},"context":{"widen":false,"gas_value":-1,"gas_scope":"global","callString_length":2},"thread":{"domain":"history","include-node":true,"wrappers":[],"unique_thread_id_count":0,"context":{"create-edges":true}},"race":{"free":true,"call":true,"direct-arithmetic":false,"volatile":true},"dead-code":{"lines":true,"branches":true,"functions":true},"extract-pthread":{"assume_success":true,"ignore_assign":true},"widen":{"tokens":false},"unassume":{"precheck":false}},"incremental":{"load":false,"load-dir":"incremental_data","only-rename":false,"save":false,"save-dir":"incremental_data","stable":true,"wpoint":false,"reluctant":{"enabled":false},"compare":"ast","detect-renames":true,"force-reanalyze":{"funs":[]},"restart":{"sided":{"enabled":false,"vars":"all","fuel":-1,"fuel-only-global":false},"list":[],"write-only":true},"postsolver":{"enabled":true,"superstable-reached":false}},"lib":{"activated":["c","posix","pthread","gcc","glibc","linux-userspace","goblint","ncurses","legacy"]},"sem":{"unknown_function":{"spawn":true,"call":true,"invalidate":{"globals":true,"args":true},"read":{"args":true}},"builtin_unreachable":{"dead_code":false},"noreturn":{"dead_code":false},"int":{"signed_overflow":"assume_top"},"null-pointer":{"dereference":"assume_none"},"malloc":{"fail":false},"lock":{"fail":false},"assert":{"refine":true},"atexit":{"ignore":false}},"trans":{"activated":[],"expeval":{"query_file_name":""},"output":"transformed.c","assert":{"function":"__VERIFIER_assert","wrap-atomic":true}},"annotation":{"int":{"enabled":false,"privglobs":true},"float":{"enabled":false},"goblint_context":{"__additional__":[]},"goblint_precision":{"__additional__":[]},"goblint_array_domain":false,"goblint_relation_track":false},"exp":{"priv-prec-dump":"","priv-distr-init":false,"relation":{"prec-dump":""},"cfgdot":false,"mincfg":false,"earlyglobs":false,"region-offsets":false,"unique":[],"forward":false,"volatiles_are_top":true,"single-threaded":false,"globs_are_top":false,"exclude_from_earlyglobs":[],"exclude_from_invalidation":[],"g2html_path":"","extraspecials":[],"no-narrow":false,"basic-blocks":false,"fast_global_inits":true,"architecture":"64bit","gcc_path":"/usr/bin/gcc","cpp-path":"","unrolling-factor":0,"hide-std-globals":true,"arg":{"enabled":false,"dot":{"path":"","node-label":"node"}}},"dbg":{"level":"info","timing":{"enabled":false,"tef":""},"trace":{"context":false},"dump":"","cilout":"","justcil-printer":"default","timeout":"0","solver-stats-interval":10,"solver-signal":"sigusr1","backtrace-signal":"sigusr2","solver-progress":false,"print_wpoints":false,"slice":{"on":false,"n":10},"limit":{"widen":0},"warn_with_context":false,"regression":false,"test":{"domain":false},"cilcfgdot":false,"cfg":{"loop-clusters":false,"loop-unrolling":false},"compare_runs":{"globsys":false,"eqsys":true,"global":false,"node":false,"diff":false},"print_tids":false,"print_protection":false,"run_cil_check":false,"full-output":false},"warn":{"assert":true,"behavior":true,"call":true,"integer":true,"float":true,"cast":true,"race":true,"deadlock":true,"deadcode":true,"analyzer":true,"unsound":true,"imprecise":true,"witness":true,"program":true,"termination":true,"unknown":true,"error":true,"warning":true,"info":true,"debug":false,"success":true,"quote-code":false,"race-threshold":0,"deterministic":true,"memleak":{"memcleanup":false,"memtrack":false}},"solvers":{"td3":{"term":true,"side_widen":"sides","space":false,"space_cache":true,"space_restore":true,"narrow-reuse":true,"remove-wpoint":true,"skip-unchanged-rhs":false,"restart":{"wpoint":{"enabled":false,"once":false}},"verify":false},"slr4":{"restart_count":1}},"witness":{"graphml":{"enabled":false,"path":"witness.graphml","id":"node","minimize":false,"uncil":false,"stack":true,"unknown":true},"invariant":{"loop-head":true,"after-lock":true,"other":true,"split-conjunction":true,"accessed":false,"full":true,"exact":true,"inexact-type-bounds":false,"exclude-vars":["tmp\\(___[0-9]+\\)?","cond","RETURN"],"all-locals":true,"goblint":false,"typedefs":true},"yaml":{"enabled":false,"format-version":"0.1","entry-types":["location_invariant","loop_invariant","flow_insensitive_invariant","loop_invariant_certificate","precondition_loop_invariant_certificate","invariant_set"],"invariant-types":["location_invariant","loop_invariant"],"path":"witness.yml","validate":"","strict":false,"unassume":"","certificate":""}}} + Did You forget to add default values to options.schema.json? + + [Info] runtime: 00:00:00.061 + [Info] vars: 2, evals: 12 + [Info] max updates: 1 for var L:call of main (299) on 01-assert.c:4:1-15:1 + + + Memory statistics: total=23.99MB, max=7.06MB, minor=21.98MB, major=6.53MB, promoted=4.52MB + minor collections=10 major collections=1 compactions=0 + + + Fatal error: exception Failure("get_path_string") + [2] + + $ goblint --enable warn.deterministic --set solver td3 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 From e57072f7560c7a5f060087be37b041c3206aa224 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 24 Oct 2024 17:26:12 +0300 Subject: [PATCH 093/157] Fix option name in topdown_space_cache_term --- src/solver/topDown_space_cache_term.ml | 2 +- tests/regression/00-sanity/01-assert.t | 25 ++++++++++--------------- 2 files changed, 11 insertions(+), 16 deletions(-) diff --git a/src/solver/topDown_space_cache_term.ml b/src/solver/topDown_space_cache_term.ml index 0022756a31..df44c376e1 100644 --- a/src/solver/topDown_space_cache_term.ml +++ b/src/solver/topDown_space_cache_term.ml @@ -170,7 +170,7 @@ module WP = ) in (* restore values for non-widening-points *) - if GobConfig.get_bool "solvers.wp.restore" then ( + if GobConfig.get_bool "solvers.td3.space_restore" then ( Logs.debug "Restoring missing values."; let restore () = let get x = diff --git a/tests/regression/00-sanity/01-assert.t b/tests/regression/00-sanity/01-assert.t index 2f81310ada..159fd5a932 100644 --- a/tests/regression/00-sanity/01-assert.t +++ b/tests/regression/00-sanity/01-assert.t @@ -112,21 +112,16 @@ Test topdown solvers: [3] $ goblint --enable warn.deterministic --set solver topdown_space_cache_term 01-assert.c - [Error] Cannot find value 'solvers.wp.restore' in - {"files":["01-assert.c"],"outfile":"","justcil":false,"justcfg":false,"verify":true,"mainfun":["main"],"exitfun":[],"otherfun":[],"allglobs":false,"kernel":false,"dump_globs":false,"result":"none","solver":"topdown_space_cache_term","comparesolver":"","allfuns":false,"nonstatic":false,"colors":"auto","g2html":false,"save_run":"","load_run":"","compare_runs":[],"warn_at":"post","gobview":false,"jobs":1,"goblint-dir":".goblint","pre":{"enabled":true,"keep":false,"exist":false,"includes":[],"kernel_includes":[],"custom_includes":[],"kernel-root":"","cppflags":[],"compdb":{"original-path":"","split":false},"transform-paths":true},"cil":{"merge":{"inlines":true},"cstd":"c99","gnu89inline":false,"addNestedScopeAttr":false},"server":{"enabled":false,"mode":"stdio","unix-socket":"goblint.sock","reparse":false},"ana":{"activated":["expRelation","base","threadid","threadflag","threadreturn","escape","mutexEvents","mutex","access","race","mallocWrapper","mhp","assert","pthreadMutexType"],"path_sens":["mutex","malloc_null","uninit","expsplit","activeSetjmp","memLeak","apron","affeq","lin2vareq"],"ctx_insens":["stack_loc","stack_trace_set"],"ctx_sens":[],"setjmp":{"split":"precise"},"int":{"def_exc":true,"interval":false,"interval_set":false,"enums":false,"congruence":false,"refinement":"never","def_exc_widen_by_join":false,"interval_narrow_by_meet":false,"interval_threshold_widening":false,"interval_threshold_widening_constants":"all"},"float":{"interval":false,"evaluate_math_functions":false},"pml":{"debug":true},"opt":{"hashcons":true,"equal":true},"autotune":{"enabled":false,"activated":["congruence","singleThreaded","specification","mallocWrappers","noRecursiveIntervals","enums","loopUnrollHeuristic","arrayDomain","octagon","wideningThresholds","memsafetySpecification","termination","tmpSpecialAnalysis"]},"sv-comp":{"enabled":false,"functions":false},"specification":"","wp":false,"arrayoob":false,"base":{"context":{"non-ptr":true,"int":true,"interval":true,"interval_set":true},"strings":{"domain":"flat"},"partition-arrays":{"keep-expr":"first","partition-by-const-on-return":false,"smart-join":false},"arrays":{"domain":"trivial","unrolling-factor":0,"nullbytes":false},"structs":{"domain":"simple","key":{"forward":true,"avoid-ints":true,"prefer-ptrs":true}},"privatization":"protection-read","priv":{"not-started":true,"must-joined":true},"invariant":{"enabled":true,"blobs":false,"unassume":"once","int":{"simplify":"all"}},"eval":{"deep-query":true}},"malloc":{"wrappers":["kmalloc","__kmalloc","usb_alloc_urb","__builtin_alloca","kzalloc"],"unique_address_count":0},"apron":{"strengthening":false,"domain":"octagon","threshold_widening":false,"threshold_widening_constants":"all","invariant":{"diff-box":false}},"relation":{"context":true,"privatization":"mutex-meet","priv":{"not-started":true,"must-joined":true},"invariant":{"one-var":false,"local":true,"global":true}},"context":{"widen":false,"gas_value":-1,"gas_scope":"global","callString_length":2},"thread":{"domain":"history","include-node":true,"wrappers":[],"unique_thread_id_count":0,"context":{"create-edges":true}},"race":{"free":true,"call":true,"direct-arithmetic":false,"volatile":true},"dead-code":{"lines":true,"branches":true,"functions":true},"extract-pthread":{"assume_success":true,"ignore_assign":true},"widen":{"tokens":false},"unassume":{"precheck":false}},"incremental":{"load":false,"load-dir":"incremental_data","only-rename":false,"save":false,"save-dir":"incremental_data","stable":true,"wpoint":false,"reluctant":{"enabled":false},"compare":"ast","detect-renames":true,"force-reanalyze":{"funs":[]},"restart":{"sided":{"enabled":false,"vars":"all","fuel":-1,"fuel-only-global":false},"list":[],"write-only":true},"postsolver":{"enabled":true,"superstable-reached":false}},"lib":{"activated":["c","posix","pthread","gcc","glibc","linux-userspace","goblint","ncurses","legacy"]},"sem":{"unknown_function":{"spawn":true,"call":true,"invalidate":{"globals":true,"args":true},"read":{"args":true}},"builtin_unreachable":{"dead_code":false},"noreturn":{"dead_code":false},"int":{"signed_overflow":"assume_top"},"null-pointer":{"dereference":"assume_none"},"malloc":{"fail":false},"lock":{"fail":false},"assert":{"refine":true},"atexit":{"ignore":false}},"trans":{"activated":[],"expeval":{"query_file_name":""},"output":"transformed.c","assert":{"function":"__VERIFIER_assert","wrap-atomic":true}},"annotation":{"int":{"enabled":false,"privglobs":true},"float":{"enabled":false},"goblint_context":{"__additional__":[]},"goblint_precision":{"__additional__":[]},"goblint_array_domain":false,"goblint_relation_track":false},"exp":{"priv-prec-dump":"","priv-distr-init":false,"relation":{"prec-dump":""},"cfgdot":false,"mincfg":false,"earlyglobs":false,"region-offsets":false,"unique":[],"forward":false,"volatiles_are_top":true,"single-threaded":false,"globs_are_top":false,"exclude_from_earlyglobs":[],"exclude_from_invalidation":[],"g2html_path":"","extraspecials":[],"no-narrow":false,"basic-blocks":false,"fast_global_inits":true,"architecture":"64bit","gcc_path":"/usr/bin/gcc","cpp-path":"","unrolling-factor":0,"hide-std-globals":true,"arg":{"enabled":false,"dot":{"path":"","node-label":"node"}}},"dbg":{"level":"info","timing":{"enabled":false,"tef":""},"trace":{"context":false},"dump":"","cilout":"","justcil-printer":"default","timeout":"0","solver-stats-interval":10,"solver-signal":"sigusr1","backtrace-signal":"sigusr2","solver-progress":false,"print_wpoints":false,"slice":{"on":false,"n":10},"limit":{"widen":0},"warn_with_context":false,"regression":false,"test":{"domain":false},"cilcfgdot":false,"cfg":{"loop-clusters":false,"loop-unrolling":false},"compare_runs":{"globsys":false,"eqsys":true,"global":false,"node":false,"diff":false},"print_tids":false,"print_protection":false,"run_cil_check":false,"full-output":false},"warn":{"assert":true,"behavior":true,"call":true,"integer":true,"float":true,"cast":true,"race":true,"deadlock":true,"deadcode":true,"analyzer":true,"unsound":true,"imprecise":true,"witness":true,"program":true,"termination":true,"unknown":true,"error":true,"warning":true,"info":true,"debug":false,"success":true,"quote-code":false,"race-threshold":0,"deterministic":true,"memleak":{"memcleanup":false,"memtrack":false}},"solvers":{"td3":{"term":true,"side_widen":"sides","space":false,"space_cache":true,"space_restore":true,"narrow-reuse":true,"remove-wpoint":true,"skip-unchanged-rhs":false,"restart":{"wpoint":{"enabled":false,"once":false}},"verify":false},"slr4":{"restart_count":1}},"witness":{"graphml":{"enabled":false,"path":"witness.graphml","id":"node","minimize":false,"uncil":false,"stack":true,"unknown":true},"invariant":{"loop-head":true,"after-lock":true,"other":true,"split-conjunction":true,"accessed":false,"full":true,"exact":true,"inexact-type-bounds":false,"exclude-vars":["tmp\\(___[0-9]+\\)?","cond","RETURN"],"all-locals":true,"goblint":false,"typedefs":true},"yaml":{"enabled":false,"format-version":"0.1","entry-types":["location_invariant","loop_invariant","flow_insensitive_invariant","loop_invariant_certificate","precondition_loop_invariant_certificate","invariant_set"],"invariant-types":["location_invariant","loop_invariant"],"path":"witness.yml","validate":"","strict":false,"unassume":"","certificate":""}}} - Did You forget to add default values to options.schema.json? - - [Info] runtime: 00:00:00.061 - [Info] vars: 2, evals: 12 - [Info] max updates: 1 for var L:call of main (299) on 01-assert.c:4:1-15:1 - - - Memory statistics: total=23.99MB, max=7.06MB, minor=21.98MB, major=6.53MB, promoted=4.52MB - minor collections=10 major collections=1 compactions=0 - - - Fatal error: exception Failure("get_path_string") - [2] + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 $ goblint --enable warn.deterministic --set solver td3 01-assert.c [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) From f0a15f65850b2ec295cb91c9005cca8265f479d9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 24 Oct 2024 17:28:39 +0300 Subject: [PATCH 094/157] Fix basic functionality of topdown_term --- src/solver/topDown_term.ml | 6 ++-- tests/regression/00-sanity/01-assert.t | 47 ++++---------------------- 2 files changed, 9 insertions(+), 44 deletions(-) diff --git a/src/solver/topDown_term.ml b/src/solver/topDown_term.ml index 9d89a42898..0099ec2115 100644 --- a/src/solver/topDown_term.ml +++ b/src/solver/topDown_term.ml @@ -24,8 +24,8 @@ module WP = let stable = HM.create 10 in let infl = HM.create 10 in (* y -> xs *) let called = HM.create 10 in - let rho = HM.create 10 in - let rho' = HM.create 10 in + let rho = HM.create 10 in (* rho for right-hand side values *) + let rho' = HM.create 10 in (* rho for start and side effect values *) let wpoint = HM.create 10 in let add_infl y x = @@ -101,7 +101,7 @@ module WP = let set_start (x,d) = if tracing then trace "sol2" "set_start %a ## %a" S.Var.pretty_trace x S.Dom.pretty d; init x; - HM.replace rho x d; + HM.replace rho' x d; solve x Widen in diff --git a/tests/regression/00-sanity/01-assert.t b/tests/regression/00-sanity/01-assert.t index 159fd5a932..60340fbd6e 100644 --- a/tests/regression/00-sanity/01-assert.t +++ b/tests/regression/00-sanity/01-assert.t @@ -65,51 +65,16 @@ Test topdown solvers: total lines: 9 $ goblint --enable warn.deterministic --set solver topdown_term 01-assert.c - [Error] Fixpoint not reached at L:entry state of main (299) on 01-assert.c:4:1-15:1 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), - mallocWrapper:(wrapper call:Unknown node, unique calls:{}), - base:({ - }, {}, {}, {}), - threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), - threadflag:Singlethreaded, - threadreturn:true, - escape:{}, - mutexEvents:(), - access:(), - mutex:(lockset:{}, multiplicity:{}), - race:(), - mhp:(), - assert:(), - pthreadMutexType:()], map:{})} - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), - mallocWrapper:(wrapper call:Unknown node, unique calls:{}), - base:({ - }, {}, {}, {}), - threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), - threadflag:Singlethreaded, - threadreturn:true, - escape:{}, - mutexEvents:(), - access:(), - mutex:(lockset:{}, multiplicity:{}), - race:(), - mhp:(), - assert:(), - pthreadMutexType:()], map:{})} instead of bot - + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) [Warning][Deadcode] Function 'main' does not return [Warning][Deadcode] Function 'main' has dead code: - on lines 4..7 (01-assert.c:4-7) - on lines 10..14 (01-assert.c:10-14) + on lines 13..14 (01-assert.c:13-14) [Warning][Deadcode] Logical lines of code (LLoC) summary: - live: 0 - dead: 9 + live: 7 + dead: 2 total lines: 9 - [Error][Unsound] Fixpoint not reached - [3] $ goblint --enable warn.deterministic --set solver topdown_space_cache_term 01-assert.c [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) From 1eb63b9ad85ade6bdbf268340a718bf2b00e27cd Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 24 Oct 2024 17:31:27 +0300 Subject: [PATCH 095/157] Fix invalid widen call in topdown_term for side effects --- src/solver/sLR.ml | 2 +- src/solver/topDown_term.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/solver/sLR.ml b/src/solver/sLR.ml index 3b46f36f5e..0cf87caeee 100644 --- a/src/solver/sLR.ml +++ b/src/solver/sLR.ml @@ -66,7 +66,7 @@ module SLR3 = if tracing then trace "sol" "Contrib:%a" S.Dom.pretty tmp; let tmp = if wpx then - if HM.mem globals x then S.Dom.widen old tmp + if HM.mem globals x then S.Dom.widen old tmp (* TODO: no join in second argument, can call widen incorrectly? *) else box old tmp else tmp in diff --git a/src/solver/topDown_term.ml b/src/solver/topDown_term.ml index 0099ec2115..5560c50f4f 100644 --- a/src/solver/topDown_term.ml +++ b/src/solver/topDown_term.ml @@ -85,7 +85,7 @@ module WP = and side y d = let old = try HM.find rho' y with Not_found -> S.Dom.bot () in if not (S.Dom.leq d old) then ( - HM.replace rho' y (S.Dom.widen old d); + HM.replace rho' y (S.Dom.widen old (S.Dom.join old d)); HM.remove stable y; init y; solve y Widen; From c348dd6101acee5dcab78278f98b27e550072576 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 24 Oct 2024 17:38:36 +0300 Subject: [PATCH 096/157] Add cram tests for remaining solvers --- src/solver/sLR.ml | 2 +- tests/regression/00-sanity/01-assert.t | 297 +++++++++++++++++++++++++ 2 files changed, 298 insertions(+), 1 deletion(-) diff --git a/src/solver/sLR.ml b/src/solver/sLR.ml index 0cf87caeee..69d415307a 100644 --- a/src/solver/sLR.ml +++ b/src/solver/sLR.ml @@ -527,7 +527,7 @@ let _ = Selector.add_solver ("widen2", (module PostSolver.EqIncrSolverFromEqSolver (W2))); Selector.add_solver ("widen3", (module PostSolver.EqIncrSolverFromEqSolver (W3))); let module S2 = TwoPhased (struct let ver = 1 end) in - Selector.add_solver ("two", (module PostSolver.EqIncrSolverFromEqSolver (S2))); + Selector.add_solver ("two", (module PostSolver.EqIncrSolverFromEqSolver (S2))); (* TODO: broken even on 00-sanity/01-assert *) let module S1 = Make (struct let ver = 1 end) in Selector.add_solver ("new", (module PostSolver.EqIncrSolverFromEqSolver (S1))); Selector.add_solver ("slr+", (module PostSolver.EqIncrSolverFromEqSolver (S1))) diff --git a/tests/regression/00-sanity/01-assert.t b/tests/regression/00-sanity/01-assert.t index 60340fbd6e..cd8c4c06f8 100644 --- a/tests/regression/00-sanity/01-assert.t +++ b/tests/regression/00-sanity/01-assert.t @@ -99,3 +99,300 @@ Test topdown solvers: live: 7 dead: 2 total lines: 9 + + +Test SLR solvers: + + $ goblint --enable warn.deterministic --set solver widen1 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver widen2 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver widen3 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver two 01-assert.c + [Error] Fixpoint not reached at L:entry state of main (299) on 01-assert.c:4:1-15:1 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), + mallocWrapper:(wrapper call:Unknown node, unique calls:{}), + base:({ + }, {}, {}, {}), + threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), + threadflag:Singlethreaded, + threadreturn:true, + escape:{}, + mutexEvents:(), + access:(), + mutex:(lockset:{}, multiplicity:{}), + race:(), + mhp:(), + assert:(), + pthreadMutexType:()], map:{})} + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), + mallocWrapper:(wrapper call:Unknown node, unique calls:{}), + base:({ + }, {}, {}, {}), + threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), + threadflag:Singlethreaded, + threadreturn:true, + escape:{}, + mutexEvents:(), + access:(), + mutex:(lockset:{}, multiplicity:{}), + race:(), + mhp:(), + assert:(), + pthreadMutexType:()], map:{})} instead of bot + + [Error] Fixpoint not reached at L:node 1 "success = 1;" on 01-assert.c:5:7-5:18 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node 2 "silence = 1;" on 01-assert.c:6:7-6:18 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node 3 "fail = 0;" on 01-assert.c:7:7-7:15 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node 4 "__goblint_assert(success);" on 01-assert.c:10:3-10:28 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node 5 "__goblint_assert(unknown == 4);" on 01-assert.c:11:3-11:33 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node 6 "__goblint_assert(fail);" on 01-assert.c:12:3-12:25 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node 7 "return (0);" on 01-assert.c:13:10-13:11 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node 9 "__goblint_assert(silence);" on 01-assert.c:14:3-14:28 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:node -299 "return;" on 01-assert.c:15:1-15:1 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Error] Fixpoint not reached at L:call of main (299) on 01-assert.c:4:1-15:1 + Solver computed: + bot + Right-Hand-Side: + HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code + Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot + + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' is uncalled: 8 LLoC (01-assert.c:4:1-15:1) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 0 + dead: 8 (8 in uncalled functions) + total lines: 8 + [Error][Unsound] Fixpoint not reached + [3] + + $ goblint --enable warn.deterministic --set solver new 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr+ 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr1 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr2 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr3 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr4 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr1p 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + $ goblint --enable warn.deterministic --set solver slr2p 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr3p 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr4p 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr3t 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 + + $ goblint --enable warn.deterministic --set solver slr3tp 01-assert.c + [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) + [Warning][Deadcode] Function 'main' does not return + [Warning][Deadcode] Function 'main' has dead code: + on lines 13..14 (01-assert.c:13-14) + [Warning][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 2 + total lines: 9 From bfeaa22ae99fadfa916c35b96aa77e694ae1d8a9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:45:30 +0300 Subject: [PATCH 097/157] Rename IntDomain -> IntDomain0 for split Adds signatures to implementation to fix "contains type variables that cannot be generalized" errors. --- src/cdomain/value/cdomains/{intDomain.ml => intDomain0.ml} | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) rename src/cdomain/value/cdomains/{intDomain.ml => intDomain0.ml} (99%) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain0.ml similarity index 99% rename from src/cdomain/value/cdomains/intDomain.ml rename to src/cdomain/value/cdomains/intDomain0.ml index e50b3f26cc..f4639d4522 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain0.ml @@ -1681,7 +1681,7 @@ struct let meet x y = if equal x y then x else bot () end -module Flat (Base: IkindUnawareS) = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) +module Flat (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) struct type int_t = Base.int_t include Lattice.FlatConf (struct @@ -1762,7 +1762,7 @@ struct | `Top | `Bot -> Invariant.none end -module Lift (Base: IkindUnawareS) = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) +module Lift (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) struct include Lattice.LiftPO (struct include Printable.DefaultConf From 6502779b680e7cf0d8331180968f4fcce5521592 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:46:20 +0300 Subject: [PATCH 098/157] Add intDomain.ml to redirect to IntDomain0 --- src/cdomain/value/cdomains/intDomain.ml | 1 + 1 file changed, 1 insertion(+) create mode 100644 src/cdomain/value/cdomains/intDomain.ml diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml new file mode 100644 index 0000000000..5fa56f5b51 --- /dev/null +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -0,0 +1 @@ +include IntDomain0 From 727c6bf418e07451930f3cf6429b4f03955beed5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:47:48 +0300 Subject: [PATCH 099/157] Rename IntDomain0 -> IntDomTuple for split --- src/cdomain/value/cdomains/{intDomain0.ml => int/intDomTuple.ml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/cdomain/value/cdomains/{intDomain0.ml => int/intDomTuple.ml} (100%) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/int/intDomTuple.ml similarity index 100% rename from src/cdomain/value/cdomains/intDomain0.ml rename to src/cdomain/value/cdomains/int/intDomTuple.ml From 227eb70a17e9729296778a7c3fcc8b9cf3fd44a5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:49:03 +0300 Subject: [PATCH 100/157] Remove non-IntDomTuple parts --- src/cdomain/value/cdomains/int/intDomTuple.ml | 3271 +---------------- 1 file changed, 1 insertion(+), 3270 deletions(-) diff --git a/src/cdomain/value/cdomains/int/intDomTuple.ml b/src/cdomain/value/cdomains/int/intDomTuple.ml index f4639d4522..7420c989fc 100644 --- a/src/cdomain/value/cdomains/int/intDomTuple.ml +++ b/src/cdomain/value/cdomains/int/intDomTuple.ml @@ -1,3273 +1,4 @@ -open GobConfig -open GoblintCil -open Pretty -open PrecisionUtil - -module M = Messages - -let (%) = Batteries.(%) -let (|?) = Batteries.(|?) - -exception IncompatibleIKinds of string -exception Unknown -exception Error -exception ArithmeticOnIntegerBot of string - - - - -(** Define records that hold mutable variables representing different Configuration values. - * These values are used to keep track of whether or not the corresponding Config values are en-/disabled *) -type ana_int_config_values = { - mutable interval_threshold_widening : bool option; - mutable interval_narrow_by_meet : bool option; - mutable def_exc_widen_by_join : bool option; - mutable interval_threshold_widening_constants : string option; - mutable refinement : string option; -} - -let ana_int_config: ana_int_config_values = { - interval_threshold_widening = None; - interval_narrow_by_meet = None; - def_exc_widen_by_join = None; - interval_threshold_widening_constants = None; - refinement = None; -} - -let get_interval_threshold_widening () = - if ana_int_config.interval_threshold_widening = None then - ana_int_config.interval_threshold_widening <- Some (get_bool "ana.int.interval_threshold_widening"); - Option.get ana_int_config.interval_threshold_widening - -let get_interval_narrow_by_meet () = - if ana_int_config.interval_narrow_by_meet = None then - ana_int_config.interval_narrow_by_meet <- Some (get_bool "ana.int.interval_narrow_by_meet"); - Option.get ana_int_config.interval_narrow_by_meet - -let get_def_exc_widen_by_join () = - if ana_int_config.def_exc_widen_by_join = None then - ana_int_config.def_exc_widen_by_join <- Some (get_bool "ana.int.def_exc_widen_by_join"); - Option.get ana_int_config.def_exc_widen_by_join - -let get_interval_threshold_widening_constants () = - if ana_int_config.interval_threshold_widening_constants = None then - ana_int_config.interval_threshold_widening_constants <- Some (get_string "ana.int.interval_threshold_widening_constants"); - Option.get ana_int_config.interval_threshold_widening_constants - -let get_refinement () = - if ana_int_config.refinement = None then - ana_int_config.refinement <- Some (get_string "ana.int.refinement"); - Option.get ana_int_config.refinement - - - -(** Whether for a given ikind, we should compute with wrap-around arithmetic. - * Always for unsigned types, for signed types if 'sem.int.signed_overflow' is 'assume_wraparound' *) -let should_wrap ik = not (Cil.isSigned ik) || get_string "sem.int.signed_overflow" = "assume_wraparound" - -(** Whether for a given ikind, we should assume there are no overflows. - * Always false for unsigned types, true for signed types if 'sem.int.signed_overflow' is 'assume_none' *) -let should_ignore_overflow ik = Cil.isSigned ik && get_string "sem.int.signed_overflow" = "assume_none" - -let widening_thresholds = ResettableLazy.from_fun WideningThresholds.thresholds -let widening_thresholds_desc = ResettableLazy.from_fun (List.rev % WideningThresholds.thresholds) - -type overflow_info = { overflow: bool; underflow: bool;} - -let set_overflow_flag ~cast ~underflow ~overflow ik = - if !AnalysisState.executing_speculative_computations then - (* Do not produce warnings when the operations are not actually happening in code *) - () - else - let signed = Cil.isSigned ik in - if !AnalysisState.postsolving && signed && not cast then - AnalysisState.svcomp_may_overflow := true; - let sign = if signed then "Signed" else "Unsigned" in - match underflow, overflow with - | true, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190; CWE 191] "%s integer overflow and underflow" sign - | true, false -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 191] "%s integer underflow" sign - | false, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190] "%s integer overflow" sign - | false, false -> assert false - -let reset_lazy () = - ResettableLazy.reset widening_thresholds; - ResettableLazy.reset widening_thresholds_desc; - ana_int_config.interval_threshold_widening <- None; - ana_int_config.interval_narrow_by_meet <- None; - ana_int_config.def_exc_widen_by_join <- None; - ana_int_config.interval_threshold_widening_constants <- None; - ana_int_config.refinement <- None - -module type Arith = -sig - type t - val neg: t -> t - val add: t -> t -> t - val sub: t -> t -> t - val mul: t -> t -> t - val div: t -> t -> t - val rem: t -> t -> t - - val lt: t -> t -> t - val gt: t -> t -> t - val le: t -> t -> t - val ge: t -> t -> t - val eq: t -> t -> t - val ne: t -> t -> t - - val lognot: t -> t - val logand: t -> t -> t - val logor : t -> t -> t - val logxor: t -> t -> t - - val shift_left : t -> t -> t - val shift_right: t -> t -> t - - val c_lognot: t -> t - val c_logand: t -> t -> t - val c_logor : t -> t -> t - -end - -module type ArithIkind = -sig - type t - val neg: Cil.ikind -> t -> t - val add: Cil.ikind -> t -> t -> t - val sub: Cil.ikind -> t -> t -> t - val mul: Cil.ikind -> t -> t -> t - val div: Cil.ikind -> t -> t -> t - val rem: Cil.ikind -> t -> t -> t - - val lt: Cil.ikind -> t -> t -> t - val gt: Cil.ikind -> t -> t -> t - val le: Cil.ikind -> t -> t -> t - val ge: Cil.ikind -> t -> t -> t - val eq: Cil.ikind -> t -> t -> t - val ne: Cil.ikind -> t -> t -> t - - val lognot: Cil.ikind -> t -> t - val logand: Cil.ikind -> t -> t -> t - val logor : Cil.ikind -> t -> t -> t - val logxor: Cil.ikind -> t -> t -> t - - val shift_left : Cil.ikind -> t -> t -> t - val shift_right: Cil.ikind -> t -> t -> t - - val c_lognot: Cil.ikind -> t -> t - val c_logand: Cil.ikind -> t -> t -> t - val c_logor : Cil.ikind -> t -> t -> t - -end - -(* Shared functions between S and Z *) -module type B = -sig - include Lattice.S - type int_t - val bot_of: Cil.ikind -> t - val top_of: Cil.ikind -> t - val to_int: t -> int_t option - val equal_to: int_t -> t -> [`Eq | `Neq | `Top] - - val to_bool: t -> bool option - val to_excl_list: t -> (int_t list * (int64 * int64)) option - val of_excl_list: Cil.ikind -> int_t list -> t - val is_excl_list: t -> bool - - val to_incl_list: t -> int_t list option - - val maximal : t -> int_t option - val minimal : t -> int_t option - - val cast_to: ?suppress_ovwarn:bool -> ?torg:Cil.typ -> Cil.ikind -> t -> t -end - -(** Interface of IntDomain implementations that do not take ikinds for arithmetic operations yet. TODO: Should be ported to S in the future. *) -module type IkindUnawareS = -sig - include B - include Arith with type t := t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: int_t -> t - val of_bool: bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val arbitrary: unit -> t QCheck.arbitrary - val invariant: Cil.exp -> t -> Invariant.t -end - -(** Interface of IntDomain implementations taking an ikind for arithmetic operations *) -module type S = -sig - include B - include ArithIkind with type t:= t - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val neg : ?no_ov:bool -> Cil.ikind -> t -> t - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t - - val join: Cil.ikind -> t -> t -> t - val meet: Cil.ikind -> t -> t -> t - val narrow: Cil.ikind -> t -> t -> t - val widen: Cil.ikind -> t -> t -> t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val is_top_of: Cil.ikind -> t -> bool - val invariant_ikind : Cil.exp -> Cil.ikind -> t -> Invariant.t - - val refine_with_congruence: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_interval: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_excl_list: Cil.ikind -> t -> (int_t list * (int64 * int64)) option -> t - val refine_with_incl_list: Cil.ikind -> t -> int_t list option -> t - - val project: Cil.ikind -> int_precision -> t -> t - val arbitrary: Cil.ikind -> t QCheck.arbitrary -end - -module type SOverflow = -sig - - include S - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val neg : ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val of_int : Cil.ikind -> int_t -> t * overflow_info - - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t * overflow_info - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - - val shift_left : Cil.ikind -> t -> t -> t * overflow_info - - val shift_right : Cil.ikind -> t -> t -> t * overflow_info -end - -module type Y = -sig - (* include B *) - include B - include Arith with type t:= t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val is_top_of: Cil.ikind -> t -> bool - - val project: int_precision -> t -> t - val invariant: Cil.exp -> t -> Invariant.t -end - -module type Z = Y with type int_t = Z.t - - -module IntDomLifter (I : S) = -struct - open Cil - type int_t = I.int_t - type t = { v : I.t; ikind : CilType.Ikind.t } [@@deriving eq, ord, hash] - - let ikind {ikind; _} = ikind - - (* Helper functions *) - let check_ikinds x y = if x.ikind <> y.ikind then raise (IncompatibleIKinds (GobPretty.sprintf "ikinds %a and %a are incompatible. Values: %a and %a" CilType.Ikind.pretty x.ikind CilType.Ikind.pretty y.ikind I.pretty x.v I.pretty y.v)) - let lift op x = {x with v = op x.ikind x.v } - (* For logical operations the result is of type int *) - let lift_logical op x = {v = op x.ikind x.v; ikind = Cil.IInt} - let lift2 op x y = check_ikinds x y; {x with v = op x.ikind x.v y.v } - let lift2_cmp op x y = check_ikinds x y; {v = op x.ikind x.v y.v; ikind = Cil.IInt} - - let bot_of ikind = { v = I.bot_of ikind; ikind} - let bot () = failwith "bot () is not implemented for IntDomLifter." - let is_bot x = I.is_bot x.v - let top_of ikind = { v = I.top_of ikind; ikind} - let top () = failwith "top () is not implemented for IntDomLifter." - let is_top x = I.is_top x.v - - (* Leq does not check for ikind, because it is used in invariant with arguments of different type. - TODO: check ikinds here and fix invariant to work with right ikinds *) - let leq x y = I.leq x.v y.v - let join = lift2 I.join - let meet = lift2 I.meet - let widen = lift2 I.widen - let narrow = lift2 I.narrow - - let show x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - "⊤" - else - I.show x.v (* TODO add ikind to output *) - let pretty () x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - Pretty.text "⊤" - else - I.pretty () x.v (* TODO add ikind to output *) - let pretty_diff () (x, y) = I.pretty_diff () (x.v, y.v) (* TODO check ikinds, add them to output *) - let printXml o x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - BatPrintf.fprintf o "\n\n⊤\n\n\n" - else - I.printXml o x.v (* TODO add ikind to output *) - (* This is for debugging *) - let name () = "IntDomLifter(" ^ (I.name ()) ^ ")" - let to_yojson x = I.to_yojson x.v - let invariant e x = - let e' = Cilfacade.mkCast ~e ~newt:(TInt (x.ikind, [])) in - I.invariant_ikind e' x.ikind x.v - let tag x = I.tag x.v - let arbitrary ik = failwith @@ "Arbitrary not implement for " ^ (name ()) ^ "." - let to_int x = I.to_int x.v - let of_int ikind x = { v = I.of_int ikind x; ikind} - let equal_to i x = I.equal_to i x.v - let to_bool x = I.to_bool x.v - let of_bool ikind b = { v = I.of_bool ikind b; ikind} - let to_excl_list x = I.to_excl_list x.v - let of_excl_list ikind is = {v = I.of_excl_list ikind is; ikind} - let is_excl_list x = I.is_excl_list x.v - let to_incl_list x = I.to_incl_list x.v - let of_interval ?(suppress_ovwarn=false) ikind (lb,ub) = {v = I.of_interval ~suppress_ovwarn ikind (lb,ub); ikind} - let of_congruence ikind (c,m) = {v = I.of_congruence ikind (c,m); ikind} - let starting ?(suppress_ovwarn=false) ikind i = {v = I.starting ~suppress_ovwarn ikind i; ikind} - let ending ?(suppress_ovwarn=false) ikind i = {v = I.ending ~suppress_ovwarn ikind i; ikind} - let maximal x = I.maximal x.v - let minimal x = I.minimal x.v - - let neg = lift I.neg - let add = lift2 I.add - let sub = lift2 I.sub - let mul = lift2 I.mul - let div = lift2 I.div - let rem = lift2 I.rem - let lt = lift2_cmp I.lt - let gt = lift2_cmp I.gt - let le = lift2_cmp I.le - let ge = lift2_cmp I.ge - let eq = lift2_cmp I.eq - let ne = lift2_cmp I.ne - let lognot = lift I.lognot - let logand = lift2 I.logand - let logor = lift2 I.logor - let logxor = lift2 I.logxor - let shift_left x y = {x with v = I.shift_left x.ikind x.v y.v } (* TODO check ikinds*) - let shift_right x y = {x with v = I.shift_right x.ikind x.v y.v } (* TODO check ikinds*) - let c_lognot = lift_logical I.c_lognot - let c_logand = lift2 I.c_logand - let c_logor = lift2 I.c_logor - - let cast_to ?(suppress_ovwarn=false) ?torg ikind x = {v = I.cast_to ~suppress_ovwarn ~torg:(TInt(x.ikind,[])) ikind x.v; ikind} - - let is_top_of ik x = ik = x.ikind && I.is_top_of ik x.v - - let relift x = { v = I.relift x.v; ikind = x.ikind } - - let project p v = { v = I.project v.ikind p v.v; ikind = v.ikind } -end - -module type Ikind = -sig - val ikind: unit -> Cil.ikind -end - -module PtrDiffIkind : Ikind = -struct - let ikind = Cilfacade.ptrdiff_ikind -end - -module IntDomWithDefaultIkind (I: Y) (Ik: Ikind) : Y with type t = I.t and type int_t = I.int_t = -struct - include I - let top () = I.top_of (Ik.ikind ()) - let bot () = I.bot_of (Ik.ikind ()) -end - -module Size = struct (* size in bits as int, range as int64 *) - open Cil - let sign x = if Z.compare x Z.zero < 0 then `Signed else `Unsigned - - let top_typ = TInt (ILongLong, []) - let min_for x = intKindForValue x (sign x = `Unsigned) - let bit = function (* bits needed for representation *) - | IBool -> 1 - | ik -> bytesSizeOfInt ik * 8 - let is_int64_big_int x = Z.fits_int64 x - let card ik = (* cardinality *) - let b = bit ik in - Z.shift_left Z.one b - let bits ik = (* highest bits for neg/pos values *) - let s = bit ik in - if isSigned ik then s-1, s-1 else 0, s - let bits_i64 ik = BatTuple.Tuple2.mapn Int64.of_int (bits ik) - let range ik = - let a,b = bits ik in - let x = if isSigned ik then Z.neg (Z.shift_left Z.one a) (* -2^a *) else Z.zero in - let y = Z.pred (Z.shift_left Z.one b) in (* 2^b - 1 *) - x,y - - let is_cast_injective ~from_type ~to_type = - let (from_min, from_max) = range (Cilfacade.get_ikind from_type) in - let (to_min, to_max) = range (Cilfacade.get_ikind to_type) in - if M.tracing then M.trace "int" "is_cast_injective %a (%a, %a) -> %a (%a, %a)" CilType.Typ.pretty from_type GobZ.pretty from_min GobZ.pretty from_max CilType.Typ.pretty to_type GobZ.pretty to_min GobZ.pretty to_max; - Z.compare to_min from_min <= 0 && Z.compare from_max to_max <= 0 - - let cast t x = (* TODO: overflow is implementation-dependent! *) - if t = IBool then - (* C11 6.3.1.2 Boolean type *) - if Z.equal x Z.zero then Z.zero else Z.one - else - let a,b = range t in - let c = card t in - let y = Z.erem x c in - let y = if Z.gt y b then Z.sub y c - else if Z.lt y a then Z.add y c - else y - in - if M.tracing then M.tracel "cast" "Cast %a to range [%a, %a] (%a) = %a (%s in int64)" GobZ.pretty x GobZ.pretty a GobZ.pretty b GobZ.pretty c GobZ.pretty y (if is_int64_big_int y then "fits" else "does not fit"); - y - - let min_range_sign_agnostic x = - let size ik = - let a,b = bits_i64 ik in - Int64.neg a,b - in - if sign x = `Signed then - size (min_for x) - else - let a, b = size (min_for x) in - if b <= 64L then - let upper_bound_less = Int64.sub b 1L in - let max_one_less = Z.(pred @@ shift_left Z.one (Int64.to_int upper_bound_less)) in - if x <= max_one_less then - a, upper_bound_less - else - a,b - else - a, b - - (* From the number of bits used to represent a positive value, determines the maximal representable value *) - let max_from_bit_range pos_bits = Z.(pred @@ shift_left Z.one (to_int (Z.of_int64 pos_bits))) - - (* From the number of bits used to represent a non-positive value, determines the minimal representable value *) - let min_from_bit_range neg_bits = Z.(if neg_bits = 0L then Z.zero else neg @@ shift_left Z.one (to_int (neg (Z.of_int64 neg_bits)))) - -end - - -module StdTop (B: sig type t val top_of: Cil.ikind -> t end) = struct - open B - (* these should be overwritten for better precision if possible: *) - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ik x = top_of ik - let ending ?(suppress_ovwarn=false) ik x = top_of ik - let maximal x = None - let minimal x = None -end - -module Std (B: sig - type t - val name: unit -> string - val top_of: Cil.ikind -> t - val bot_of: Cil.ikind -> t - val show: t -> string - val equal: t -> t -> bool - end) = struct - include Printable.StdLeaf - let name = B.name (* overwrite the one from Printable.Std *) - open B - let is_top x = failwith "is_top not implemented for IntDomain.Std" - let is_bot x = B.equal x (bot_of Cil.IInt) (* Here we assume that the representation of bottom is independent of the ikind - This may be true for intdomain implementations, but not e.g. for IntDomLifter. *) - let is_top_of ik x = B.equal x (top_of ik) - - (* all output is based on B.show *) - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - let pretty_diff () (x,y) = dprintf "%s: %a instead of %a" (name ()) pretty x pretty y - - include StdTop (B) -end - -(* Textbook interval arithmetic, without any overflow handling etc. *) -module IntervalArith (Ints_t : IntOps.IntOps) = struct - let min4 a b c d = Ints_t.min (Ints_t.min a b) (Ints_t.min c d) - let max4 a b c d = Ints_t.max (Ints_t.max a b) (Ints_t.max c d) - - let mul (x1, x2) (y1, y2) = - let x1y1 = (Ints_t.mul x1 y1) in - let x1y2 = (Ints_t.mul x1 y2) in - let x2y1 = (Ints_t.mul x2 y1) in - let x2y2 = (Ints_t.mul x2 y2) in - (min4 x1y1 x1y2 x2y1 x2y2, max4 x1y1 x1y2 x2y1 x2y2) - - let shift_left (x1,x2) (y1,y2) = - let y1p = Ints_t.shift_left Ints_t.one y1 in - let y2p = Ints_t.shift_left Ints_t.one y2 in - mul (x1, x2) (y1p, y2p) - - let div (x1, x2) (y1, y2) = - let x1y1n = (Ints_t.div x1 y1) in - let x1y2n = (Ints_t.div x1 y2) in - let x2y1n = (Ints_t.div x2 y1) in - let x2y2n = (Ints_t.div x2 y2) in - let x1y1p = (Ints_t.div x1 y1) in - let x1y2p = (Ints_t.div x1 y2) in - let x2y1p = (Ints_t.div x2 y1) in - let x2y2p = (Ints_t.div x2 y2) in - (min4 x1y1n x1y2n x2y1n x2y2n, max4 x1y1p x1y2p x2y1p x2y2p) - - let add (x1, x2) (y1, y2) = (Ints_t.add x1 y1, Ints_t.add x2 y2) - let sub (x1, x2) (y1, y2) = (Ints_t.sub x1 y2, Ints_t.sub x2 y1) - - let neg (x1, x2) = (Ints_t.neg x2, Ints_t.neg x1) - - let one = (Ints_t.one, Ints_t.one) - let zero = (Ints_t.zero, Ints_t.zero) - let top_bool = (Ints_t.zero, Ints_t.one) - - let to_int (x1, x2) = - if Ints_t.equal x1 x2 then Some x1 else None - - let upper_threshold u max_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - let max_ik' = Ints_t.to_bigint max_ik in - let t = List.find_opt (fun x -> Z.compare u x <= 0 && Z.compare x max_ik' <= 0) ts in - BatOption.map_default Ints_t.of_bigint max_ik t - let lower_threshold l min_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - let min_ik' = Ints_t.to_bigint min_ik in - let t = List.find_opt (fun x -> Z.compare l x >= 0 && Z.compare x min_ik' >= 0) ts in - BatOption.map_default Ints_t.of_bigint min_ik t - let is_upper_threshold u = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - List.exists (Z.equal u) ts - let is_lower_threshold l = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - List.exists (Z.equal l) ts -end - -module IntInvariant = -struct - let of_int e ik x = - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.none - - let of_incl_list e ik ps = - match ps with - | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> - assert (List.mem Z.zero ps); - assert (List.mem Z.one ps); - Invariant.none - | [_] when get_bool "witness.invariant.exact" -> - Invariant.none - | _ :: _ :: _ - | [_] | [] -> - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ps - - let of_interval_opt e ik = function - | (Some x1, Some x2) when Z.equal x1 x2 -> - of_int e ik x1 - | x1_opt, x2_opt -> - let (min_ik, max_ik) = Size.range ik in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = - match x1_opt, inexact_type_bounds with - | Some x1, false when Z.equal min_ik x1 -> Invariant.none - | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) - | None, _ -> Invariant.none - in - let i2 = - match x2_opt, inexact_type_bounds with - | Some x2, false when Z.equal x2 max_ik -> Invariant.none - | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) - | None, _ -> Invariant.none - in - Invariant.(i1 && i2) - - let of_interval e ik (x1, x2) = - of_interval_opt e ik (Some x1, Some x2) - - let of_excl_list e ik ns = - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) (Invariant.top ()) ns -end - -module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = -struct - let name () = "intervals" - type int_t = Ints_t.t - type t = (Ints_t.t * Ints_t.t) option [@@deriving eq, ord, hash] - module IArith = IntervalArith (Ints_t) - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - let top_of ik = Some (range ik) - let bot () = None - let bot_of ik = bot () (* TODO: improve *) - - let show = function None -> "bottom" | Some (x,y) -> "["^Ints_t.to_string x^","^Ints_t.to_string y^"]" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) -> - if a = b && b = i then `Eq else if Ints_t.compare a i <= 0 && Ints_t.compare i b <=0 then `Top else `Neq - - let norm ?(suppress_ovwarn=false) ?(cast=false) ik : (t -> t * overflow_info) = function None -> (None, {underflow=false; overflow=false}) | Some (x,y) -> - if Ints_t.compare x y > 0 then - (None,{underflow=false; overflow=false}) - else ( - let (min_ik, max_ik) = range ik in - let underflow = Ints_t.compare min_ik x > 0 in - let overflow = Ints_t.compare max_ik y < 0 in - let ov_info = { underflow = underflow && not suppress_ovwarn; overflow = overflow && not suppress_ovwarn } in - let v = - if underflow || overflow then - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (Ints_t.sub max_ik min_ik) in - let resdiff = Ints_t.abs (Ints_t.sub y x) in - if Ints_t.compare resdiff diff > 0 then - top_of ik - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if Ints_t.compare l u <= 0 then - Some (l, u) - else - (* Interval that wraps around (begins to the right of its end). We can not represent such intervals *) - top_of ik - else if not cast && should_ignore_overflow ik then - let tl, tu = BatOption.get @@ top_of ik in - Some (Ints_t.max tl x, Ints_t.min tu y) - else - top_of ik - else - Some (x,y) - in - (v, ov_info) - ) - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (x1,x2), Some (y1,y2) -> Ints_t.compare x1 y1 >= 0 && Ints_t.compare x2 y2 <= 0 - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.min x1 y1, Ints_t.max x2 y2) |> fst - - let meet ik (x:t) y = - match x, y with - | None, z | z, None -> None - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.max x1 y1, Ints_t.min x2 y2) |> fst - - (* TODO: change to_int signature so it returns a big_int *) - let to_int x = Option.bind x (IArith.to_int) - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm ~suppress_ovwarn ik @@ Some (x,y) - let of_int ik (x: int_t) = of_interval ik (x,x) - let zero = Some IArith.zero - let one = Some IArith.one - let top_bool = Some IArith.top_bool - - let of_bool _ik = function true -> one | false -> zero - let to_bool (a: t) = match a with - | None -> None - | Some (l, u) when Ints_t.compare l Ints_t.zero = 0 && Ints_t.compare u Ints_t.zero = 0 -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (fst (range ik), n) - - (* TODO: change signature of maximal, minimal to return big_int*) - let maximal = function None -> None | Some (x,y) -> Some y - let minimal = function None -> None | Some (x,y) -> Some x - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov t = norm ~cast:true t (* norm does all overflow handling *) - - let widen ik x y = - match x, y with - | None, z | z, None -> z - | Some (l0,u0), Some (l1,u1) -> - let (min_ik, max_ik) = range ik in - let threshold = get_interval_threshold_widening () in - let l2 = - if Ints_t.compare l0 l1 = 0 then l0 - else if threshold then IArith.lower_threshold l1 min_ik - else min_ik - in - let u2 = - if Ints_t.compare u0 u1 = 0 then u0 - else if threshold then IArith.upper_threshold u1 max_ik - else max_ik - in - norm ik @@ Some (l2,u2) |> fst - let widen ik x y = - let r = widen ik x y in - if M.tracing && not (equal x y) then M.tracel "int" "interval widen %a %a -> %a" pretty x pretty y pretty r; - assert (leq x y); (* TODO: remove for performance reasons? *) - r - - let narrow ik x y = - match x, y with - | _,None | None, _ -> None - | Some (x1,x2), Some (y1,y2) -> - let threshold = get_interval_threshold_widening () in - let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 || threshold && Ints_t.compare y1 x1 > 0 && IArith.is_lower_threshold x1 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 || threshold && Ints_t.compare y2 x2 < 0 && IArith.is_upper_threshold x2 then y2 else x2 in - norm ik @@ Some (lr,ur) |> fst - - - let narrow ik x y = - if get_interval_narrow_by_meet () then - meet ik x y - else - narrow ik x y - - let log f ~annihilator ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, _ when x = annihilator -> of_bool ik annihilator - | _, Some y when y = annihilator -> of_bool ik annihilator - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) ~annihilator:true - let c_logand = log (&&) ~annihilator:false - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let bit f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - let bitcomp f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{underflow=false; overflow=false})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let logxor = bit (fun _ik -> Ints_t.logxor) - - let logand ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (Ints_t.logand x y) |> fst with Division_by_zero -> top_of ik) - | _, Some y when Ints_t.equal y Ints_t.zero -> of_int ik Ints_t.zero |> fst - | _, Some y when Ints_t.equal y Ints_t.one -> of_interval ik (Ints_t.zero, Ints_t.one) |> fst - | _ -> top_of ik - - let logor = bit (fun _ik -> Ints_t.logor) - - let bit1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_int i1 with - | Some x -> of_int ik (f ik x) |> fst - | _ -> top_of ik - - let lognot = bit1 (fun _ik -> Ints_t.lognot) - let shift_right = bitcomp (fun _ik x y -> Ints_t.shift_right x (Ints_t.to_int y)) - - let neg ?no_ov ik = function None -> (None,{underflow=false; overflow=false}) | Some x -> norm ik @@ Some (IArith.neg x) - - let binary_op_with_norm ?no_ov op ik x y = match x, y with - | None, None -> (None, {overflow=false; underflow= false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some x, Some y -> norm ik @@ Some (op x y) - - let add ?no_ov = binary_op_with_norm IArith.add - let mul ?no_ov = binary_op_with_norm IArith.mul - let sub ?no_ov = binary_op_with_norm IArith.sub - - let shift_left ik a b = - match is_bot a, is_bot b with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show a) (show b))) - | _ -> - match a, minimal b, maximal b with - | Some a, Some bl, Some bu when (Ints_t.compare bl Ints_t.zero >= 0) -> - (try - let r = IArith.shift_left a (Ints_t.to_int bl, Ints_t.to_int bu) in - norm ik @@ Some r - with Z.Overflow -> (top_of ik,{underflow=false; overflow=true})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let rem ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (xl, xu), Some (yl, yu) -> - if is_top_of ik x && is_top_of ik y then - (* This is needed to preserve soundness also on things bigger than int32 e.g. *) - (* x: 3803957176L -> T in Interval32 *) - (* y: 4209861404L -> T in Interval32 *) - (* x % y: 3803957176L -> T in Interval32 *) - (* T in Interval32 is [-2147483648,2147483647] *) - (* the code below computes [-2147483647,2147483647] for this though which is unsound *) - top_of ik - else - (* If we have definite values, Ints_t.rem will give a definite result. - * Otherwise we meet with a [range] the result can be in. - * This range is [0, min xu b] if x is positive, and [max xl -b, min xu b] if x can be negative. - * The precise bound b is one smaller than the maximum bound. Negative y give the same result as positive. *) - let pos x = if Ints_t.compare x Ints_t.zero < 0 then Ints_t.neg x else x in - let b = Ints_t.sub (Ints_t.max (pos yl) (pos yu)) Ints_t.one in - let range = if Ints_t.compare xl Ints_t.zero>= 0 then Some (Ints_t.zero, Ints_t.min xu b) else Some (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit (fun _ik -> Ints_t.rem) ik x y) range - - let rec div ?no_ov ik x y = - match x, y with - | None, None -> (bot (),{underflow=false; overflow=false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | (Some (x1,x2) as x), (Some (y1,y2) as y) -> - begin - let is_zero v = Ints_t.compare v Ints_t.zero = 0 in - match y1, y2 with - | l, u when is_zero l && is_zero u -> (top_of ik,{underflow=false; overflow=false}) (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> div ik (Some (x1,x2)) (Some (Ints_t.one,y2)) - | _, u when is_zero u -> div ik (Some (x1,x2)) (Some (y1, Ints_t.(neg one))) - | _ when leq (of_int ik (Ints_t.zero) |> fst) (Some (y1,y2)) -> (top_of ik,{underflow=false; overflow=false}) - | _ -> binary_op_with_norm IArith.div ik x y - end - - let ne ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik true - else if Ints_t.compare x2 y1 <= 0 && Ints_t.compare y2 x1 <= 0 then - of_bool ik false - else top_bool - - let eq ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 && Ints_t.compare x2 y1 <= 0 then - of_bool ik true - else if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik false - else top_bool - - let ge ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 then of_bool ik true - else if Ints_t.compare x2 y1 < 0 then of_bool ik false - else top_bool - - let le ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 <= 0 then of_bool ik true - else if Ints_t.compare y2 x1 < 0 then of_bool ik false - else top_bool - - let gt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 then of_bool ik true - else if Ints_t.compare x2 y1 <= 0 then of_bool ik false - else top_bool - - let lt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 < 0 then of_bool ik true - else if Ints_t.compare y2 x1 <= 0 then of_bool ik false - else top_bool - - let invariant_ikind e ik = function - | Some (x1, x2) -> - let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in - IntInvariant.of_interval e ik (x1', x2') - | None -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let shrink = function - | Some (l, u) -> (return None) <+> (GobQCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) - | None -> empty - in - QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) (fun x -> of_interval ik x |> fst ) pair_arb) - - let modulo n k = - let result = Ints_t.rem n k in - if Ints_t.compare result Ints_t.zero >= 0 then result - else Ints_t.add result k - - let refine_with_congruence ik (intv : t) (cong : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if Ints_t.equal m Ints_t.zero && (Ints_t.compare c x < 0 || Ints_t.compare c y > 0) then None - else if Ints_t.equal m Ints_t.zero then - Some (c, c) - else - let (min_ik, max_ik) = range ik in - let rcx = - if Ints_t.equal x min_ik then x else - Ints_t.add x (modulo (Ints_t.sub c x) (Ints_t.abs m)) in - let lcy = - if Ints_t.equal y max_ik then y else - Ints_t.sub y (modulo (Ints_t.sub y c) (Ints_t.abs m)) in - if Ints_t.compare rcx lcy > 0 then None - else if Ints_t.equal rcx lcy then norm ik @@ Some (rcx, rcx) |> fst - else norm ik @@ Some (rcx, lcy) |> fst - | _ -> None - - let refine_with_congruence ik x y = - let refn = refine_with_congruence ik x y in - if M.tracing then M.trace "refine" "int_refine_with_congruence %a %a -> %a" pretty x pretty y pretty refn; - refn - - let refine_with_interval ik a b = meet ik a b - - let refine_with_excl_list ik (intv : t) (excl : (int_t list * (int64 * int64)) option) : t = - match intv, excl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls, (rl, rh)) -> - let rec shrink op b = - let new_b = (op b (Ints_t.of_int(Bool.to_int(BatList.mem_cmp Ints_t.compare b ls)))) in - if not (Ints_t.equal b new_b) then shrink op new_b else new_b - in - let (min_ik, max_ik) = range ik in - let l' = if Ints_t.equal l min_ik then l else shrink Ints_t.add l in - let u' = if Ints_t.equal u max_ik then u else shrink Ints_t.sub u in - let intv' = norm ik @@ Some (l', u') |> fst in - let range = norm ~suppress_ovwarn:true ik (Some (Ints_t.of_bigint (Size.min_from_bit_range rl), Ints_t.of_bigint (Size.max_from_bit_range rh))) |> fst in - meet ik intv' range - - let refine_with_incl_list ik (intv: t) (incl : (int_t list) option) : t = - match intv, incl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls) -> - let rec min m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> min (Some x) xs | Some m -> if Ints_t.compare m x < 0 then min (Some m) xs else min (Some x) xs in - let rec max m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> max (Some x) xs | Some m -> if Ints_t.compare m x > 0 then max (Some m) xs else max (Some x) xs in - match min None ls, max None ls with - | Some m1, Some m2 -> refine_with_interval ik (Some(l, u)) (Some (m1, m2)) - | _, _-> intv - - let project ik p t = t -end - -(** IntervalSetFunctor that is not just disjunctive completion of intervals, but attempts to be precise for wraparound arithmetic for unsigned types *) -module IntervalSetFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) list = -struct - - module Interval = IntervalFunctor (Ints_t) - module IArith = IntervalArith (Ints_t) - - - let name () = "interval_sets" - - type int_t = Ints_t.t - - let (>.) a b = Ints_t.compare a b > 0 - let (=.) a b = Ints_t.compare a b = 0 - let (<.) a b = Ints_t.compare a b < 0 - let (>=.) a b = Ints_t.compare a b >= 0 - let (<=.) a b = Ints_t.compare a b <= 0 - let (+.) a b = Ints_t.add a b - let (-.) a b = Ints_t.sub a b - - (* - Each domain's element is guaranteed to be in canonical form. That is, each interval contained - inside the set does not overlap with each other and they are not adjacent. - *) - type t = (Ints_t.t * Ints_t.t) list [@@deriving eq, hash, ord] - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - - let top_of ik = [range ik] - - let bot () = [] - - let bot_of ik = bot () - - let show (x: t) = - let show_interval i = Printf.sprintf "[%s, %s]" (Ints_t.to_string (fst i)) (Ints_t.to_string (snd i)) in - List.fold_left (fun acc i -> (show_interval i) :: acc) [] x |> List.rev |> String.concat ", " |> Printf.sprintf "[%s]" - - (* New type definition for the sweeping line algorithm used for implementing join/meet functions. *) - type event = Enter of Ints_t.t | Exit of Ints_t.t - - let unbox_event = function Enter x -> x | Exit x -> x - - let cmp_events x y = - (* Deliberately comparing ints first => Cannot be derived *) - let res = Ints_t.compare (unbox_event x) (unbox_event y) in - if res <> 0 then res - else - begin - match (x, y) with - | (Enter _, Exit _) -> -1 - | (Exit _, Enter _) -> 1 - | (_, _) -> 0 - end - - let interval_set_to_events (xs: t) = - List.concat_map (fun (a, b) -> [Enter a; Exit b]) xs - - let two_interval_sets_to_events (xs: t) (ys: t) = - let xs = interval_set_to_events xs in - let ys = interval_set_to_events ys in - List.merge cmp_events xs ys - - (* Using the sweeping line algorithm, combined_event_list returns a new event list representing the intervals in which at least n intervals in xs overlap - This function is used for both join and meet operations with different parameter n: 1 for join, 2 for meet *) - let combined_event_list lattice_op (xs:event list) = - let l = match lattice_op with `Join -> 1 | `Meet -> 2 in - let aux (interval_count, acc) = function - | Enter x -> (interval_count + 1, if (interval_count + 1) >= l && interval_count < l then (Enter x)::acc else acc) - | Exit x -> (interval_count - 1, if interval_count >= l && (interval_count - 1) < l then (Exit x)::acc else acc) - in - List.fold_left aux (0, []) xs |> snd |> List.rev - - let rec events_to_intervals = function - | [] -> [] - | (Enter x)::(Exit y)::xs -> (x, y)::(events_to_intervals xs) - | _ -> failwith "Invalid events list" - - let remove_empty_gaps (xs: t) = - let aux acc (l, r) = match acc with - | ((a, b)::acc') when (b +. Ints_t.one) >=. l -> (a, r)::acc' - | _ -> (l, r)::acc - in - List.fold_left aux [] xs |> List.rev - - let canonize (xs: t) = - interval_set_to_events xs |> - List.sort cmp_events |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let unop (x: t) op = match x with - | [] -> [] - | _ -> canonize @@ List.concat_map op x - - let binop (x: t) (y: t) op : t = match x, y with - | [], _ -> [] - | _, [] -> [] - | _, _ -> canonize @@ List.concat_map op (BatList.cartesian_product x y) - - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let minimal = function - | [] -> None - | (x, _)::_ -> Some x - - let maximal = function - | [] -> None - | xs -> Some (BatList.last xs |> snd) - - let equal_to_interval i (a, b) = - if a =. b && b =. i then - `Eq - else if a <=. i && i <=. b then - `Top - else - `Neq - - let equal_to i xs = match List.map (equal_to_interval i) xs with - | [] -> failwith "unsupported: equal_to with bottom" - | [`Eq] -> `Eq - | ys when List.for_all ((=) `Neq) ys -> `Neq - | _ -> `Top - - let norm_interval ?(suppress_ovwarn=false) ?(cast=false) ik (x,y) : t*overflow_info = - if x >. y then - ([],{underflow=false; overflow=false}) - else - let (min_ik, max_ik) = range ik in - let underflow = min_ik >. x in - let overflow = max_ik <. y in - let v = if underflow || overflow then - begin - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (max_ik -. min_ik) in - let resdiff = Ints_t.abs (y -. x) in - if resdiff >. diff then - [range ik] - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if l <=. u then - [(l, u)] - else - (* Interval that wraps around (begins to the right of its end). We CAN represent such intervals *) - [(min_ik, u); (l, max_ik)] - else if not cast && should_ignore_overflow ik then - [Ints_t.max min_ik x, Ints_t.min max_ik y] - else - [range ik] - end - else - [(x,y)] - in - if suppress_ovwarn then (v, {underflow=false; overflow=false}) else (v, {underflow; overflow}) - - let norm_intvs ?(suppress_ovwarn=false) ?(cast=false) (ik:ikind) (xs: t) : t*overflow_info = - let res = List.map (norm_interval ~suppress_ovwarn ~cast ik) xs in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let binary_op_with_norm op (ik:ikind) (x: t) (y: t) : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> norm_intvs ik @@ List.concat_map (fun (x,y) -> [op x y]) (BatList.cartesian_product x y) - - let binary_op_with_ovc (x: t) (y: t) op : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> - let res = List.map op (BatList.cartesian_product x y) in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let unary_op_with_norm op (ik:ikind) (x: t) = match x with - | [] -> ([],{overflow=false; underflow=false}) - | _ -> norm_intvs ik @@ List.concat_map (fun x -> [op x]) x - - let rec leq (xs: t) (ys: t) = - let leq_interval (al, au) (bl, bu) = al >=. bl && au <=. bu in - match xs, ys with - | [], _ -> true - | _, [] -> false - | (xl,xr)::xs', (yl,yr)::ys' -> - if leq_interval (xl,xr) (yl,yr) then - leq xs' ys - else if xr <. yl then - false - else - leq xs ys' - - let join ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let meet ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Meet |> - events_to_intervals - - let to_int = function - | [x] -> IArith.to_int x - | _ -> None - - let zero = [IArith.zero] - let one = [IArith.one] - let top_bool = [IArith.top_bool] - - let not_bool (x:t) = - let is_false x = equal x zero in - let is_true x = equal x one in - if is_true x then zero else if is_false x then one else top_bool - - let to_bool = function - | [(l,u)] when l =. Ints_t.zero && u =. Ints_t.zero -> Some false - | x -> if leq zero x then None else Some true - - let of_bool _ = function true -> one | false -> zero - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm_interval ~suppress_ovwarn ~cast:false ik (x,y) - - let of_int ik (x: int_t) = of_interval ik (x, x) - - let lt ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <. min_y then - of_bool ik true - else if min_x >=. max_y then - of_bool ik false - else - top_bool - - let le ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <=. min_y then - of_bool ik true - else if min_x >. max_y then - of_bool ik false - else - top_bool - - let gt ik x y = not_bool @@ le ik x y - - let ge ik x y = not_bool @@ lt ik x y - - let eq ik x y = match x, y with - | (a, b)::[], (c, d)::[] when a =. b && c =. d && a =. c -> - one - | _ -> - if is_bot (meet ik x y) then - zero - else - top_bool - - let ne ik x y = not_bool @@ eq ik x y - let interval_to_int i = Interval.to_int (Some i) - let interval_to_bool i = Interval.to_bool (Some i) - - let log f ik (i1, i2) = - match (interval_to_bool i1, interval_to_bool i2) with - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - - let bit f ik (i1, i2) = - match (interval_to_int i1), (interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - - let bitcomp f ik (i1, i2) = - match (interval_to_int i1, interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{overflow=false; underflow=false})) - | _, _ -> (top_of ik,{overflow=false; underflow=false}) - - let logand ik x y = - let interval_logand = bit Ints_t.logand ik in - binop x y interval_logand - - let logor ik x y = - let interval_logor = bit Ints_t.logor ik in - binop x y interval_logor - - let logxor ik x y = - let interval_logxor = bit Ints_t.logxor ik in - binop x y interval_logxor - - let lognot ik x = - let interval_lognot i = - match interval_to_int i with - | Some x -> of_int ik (Ints_t.lognot x) |> fst - | _ -> top_of ik - in - unop x interval_lognot - - let shift_left ik x y = - let interval_shiftleft = bitcomp (fun x y -> Ints_t.shift_left x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftleft - - let shift_right ik x y = - let interval_shiftright = bitcomp (fun x y -> Ints_t.shift_right x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftright - - let c_lognot ik x = - let log1 f ik i1 = - match interval_to_bool i1 with - | Some x -> of_bool ik (f x) - | _ -> top_of ik - in - let interval_lognot = log1 not ik in - unop x interval_lognot - - let c_logand ik x y = - let interval_logand = log (&&) ik in - binop x y interval_logand - - let c_logor ik x y = - let interval_logor = log (||) ik in - binop x y interval_logor - - let add ?no_ov = binary_op_with_norm IArith.add - let sub ?no_ov = binary_op_with_norm IArith.sub - let mul ?no_ov = binary_op_with_norm IArith.mul - let neg ?no_ov = unary_op_with_norm IArith.neg - - let div ?no_ov ik x y = - let rec interval_div x (y1, y2) = begin - let top_of ik = top_of ik |> List.hd in - let is_zero v = v =. Ints_t.zero in - match y1, y2 with - | l, u when is_zero l && is_zero u -> top_of ik (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> interval_div x (Ints_t.one,y2) - | _, u when is_zero u -> interval_div x (y1, Ints_t.(neg one)) - | _ when leq (of_int ik (Ints_t.zero) |> fst) ([(y1,y2)]) -> top_of ik - | _ -> IArith.div x (y1, y2) - end - in binary_op_with_norm interval_div ik x y - - let rem ik x y = - let interval_rem (x, y) = - if Interval.is_top_of ik (Some x) && Interval.is_top_of ik (Some y) then - top_of ik - else - let (xl, xu) = x in let (yl, yu) = y in - let pos x = if x <. Ints_t.zero then Ints_t.neg x else x in - let b = (Ints_t.max (pos yl) (pos yu)) -. Ints_t.one in - let range = if xl >=. Ints_t.zero then (Ints_t.zero, Ints_t.min xu b) else (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit Ints_t.rem ik (x, y)) [range] - in - binop x y interval_rem - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik x = norm_intvs ~cast:true ik x - - (* - narrows down the extremeties of xs if they are equal to boundary values of the ikind with (possibly) narrower values from ys - *) - let narrow ik xs ys = match xs ,ys with - | [], _ -> [] | _ ,[] -> xs - | _, _ -> - let min_xs = minimal xs |> Option.get in - let max_xs = maximal xs |> Option.get in - let min_ys = minimal ys |> Option.get in - let max_ys = maximal ys |> Option.get in - let min_range,max_range = range ik in - let threshold = get_interval_threshold_widening () in - let min = if min_xs =. min_range || threshold && min_ys >. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in - let max = if max_xs =. max_range || threshold && max_ys <. max_xs && IArith.is_upper_threshold max_xs then max_ys else max_xs in - xs - |> (function (_, y)::z -> (min, y)::z | _ -> []) - |> List.rev - |> (function (x, _)::z -> (x, max)::z | _ -> []) - |> List.rev - - (* - 1. partitions the intervals of xs by assigning each of them to the an interval in ys that includes it. - and joins all intervals in xs assigned to the same interval in ys as one interval. - 2. checks for every pair of adjacent pairs whether the pairs did approach (if you compare the intervals from xs and ys) and merges them if it is the case. - 3. checks whether partitions at the extremeties are approaching infinity (and expands them to infinity. in that case) - - The expansion (between a pair of adjacent partitions or at extremeties ) stops at a threshold. - *) - let widen ik xs ys = - let (min_ik,max_ik) = range ik in - let threshold = get_bool "ana.int.interval_threshold_widening" in - let upper_threshold (_,u) = IArith.upper_threshold u max_ik in - let lower_threshold (l,_) = IArith.lower_threshold l min_ik in - (*obtain partitioning of xs intervals according to the ys interval that includes them*) - let rec interval_sets_to_partitions (ik: ikind) (acc : (int_t * int_t) option) (xs: t) (ys: t)= - match xs,ys with - | _, [] -> [] - | [], (y::ys) -> (acc,y):: interval_sets_to_partitions ik None [] ys - | (x::xs), (y::ys) when Interval.leq (Some x) (Some y) -> interval_sets_to_partitions ik (Interval.join ik acc (Some x)) xs (y::ys) - | (x::xs), (y::ys) -> (acc,y) :: interval_sets_to_partitions ik None (x::xs) ys - in - let interval_sets_to_partitions ik xs ys = interval_sets_to_partitions ik None xs ys in - (*merge a pair of adjacent partitions*) - let merge_pair ik (a,b) (c,d) = - let new_a = function - | None -> Some (upper_threshold b, upper_threshold b) - | Some (ax,ay) -> Some (ax, upper_threshold b) - in - let new_c = function - | None -> Some (lower_threshold d, lower_threshold d) - | Some (cx,cy) -> Some (lower_threshold d, cy) - in - if threshold && (lower_threshold d +. Ints_t.one) >. (upper_threshold b) then - [(new_a a,(fst b, upper_threshold b)); (new_c c, (lower_threshold d, snd d))] - else - [(Interval.join ik a c, (Interval.join ik (Some b) (Some d) |> Option.get))] - in - let partitions_are_approaching part_left part_right = match part_left, part_right with - | (Some (_, left_x), (_, left_y)), (Some (right_x, _), (right_y, _)) -> (right_x -. left_x) >. (right_y -. left_y) - | _,_ -> false - in - (*merge all approaching pairs of adjacent partitions*) - let rec merge_list ik = function - | [] -> [] - | x::y::xs when partitions_are_approaching x y -> merge_list ik ((merge_pair ik x y) @ xs) - | x::xs -> x :: merge_list ik xs - in - (*expands left extremity*) - let widen_left = function - | [] -> [] - | (None,(lb,rb))::ts -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (None, (lt,rb))::ts - | (Some (la,ra), (lb,rb))::ts when lb <. la -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (Some (la,ra),(lt,rb))::ts - | x -> x - in - (*expands right extremity*) - let widen_right x = - let map_rightmost = function - | [] -> [] - | (None,(lb,rb))::ts -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (None, (lb,ut))::ts - | (Some (la,ra), (lb,rb))::ts when ra <. rb -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (Some (la,ra),(lb,ut))::ts - | x -> x - in - List.rev x |> map_rightmost |> List.rev - in - interval_sets_to_partitions ik xs ys |> merge_list ik |> widen_left |> widen_right |> List.map snd - - let starting ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (fst (range ik), n) - - let invariant_ikind e ik xs = - List.map (fun x -> Interval.invariant_ikind e ik (Some x)) xs |> - let open Invariant in List.fold_left (||) (bot ()) - - let modulo n k = - let result = Ints_t.rem n k in - if result >=. Ints_t.zero then result - else result +. k - - let refine_with_congruence ik (intvs: t) (cong: (int_t * int_t ) option): t = - let refine_with_congruence_interval ik (cong : (int_t * int_t ) option) (intv : (int_t * int_t ) option): t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if m =. Ints_t.zero && (c <. x || c >. y) then [] - else if m =. Ints_t.zero then - [(c, c)] - else - let (min_ik, max_ik) = range ik in - let rcx = - if x =. min_ik then x else - x +. (modulo (c -. x) (Ints_t.abs m)) in - let lcy = - if y =. max_ik then y else - y -. (modulo (y -. c) (Ints_t.abs m)) in - if rcx >. lcy then [] - else if rcx =. lcy then norm_interval ik (rcx, rcx) |> fst - else norm_interval ik (rcx, lcy) |> fst - | _ -> [] - in - List.concat_map (fun x -> refine_with_congruence_interval ik cong (Some x)) intvs - - let refine_with_interval ik xs = function None -> [] | Some (a,b) -> meet ik xs [(a,b)] - - let refine_with_incl_list ik intvs = function - | None -> intvs - | Some xs -> meet ik intvs (List.map (fun x -> (x,x)) xs) - - let excl_range_to_intervalset (ik: ikind) ((min, max): int_t * int_t) (excl: int_t): t = - let intv1 = (min, excl -. Ints_t.one) in - let intv2 = (excl +. Ints_t.one, max) in - norm_intvs ik ~suppress_ovwarn:true [intv1 ; intv2] |> fst - - let of_excl_list ik (excls: int_t list) = - let excl_list = List.map (excl_range_to_intervalset ik (range ik)) excls in - let res = List.fold_left (meet ik) (top_of ik) excl_list in - res - - let refine_with_excl_list ik (intv : t) = function - | None -> intv - | Some (xs, range) -> - let excl_to_intervalset (ik: ikind) ((rl, rh): (int64 * int64)) (excl: int_t): t = - excl_range_to_intervalset ik (Ints_t.of_bigint (Size.min_from_bit_range rl),Ints_t.of_bigint (Size.max_from_bit_range rh)) excl - in - let excl_list = List.map (excl_to_intervalset ik range) xs in - List.fold_left (meet ik) intv excl_list - - let project ik p t = t - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let list_pair_arb = QCheck.small_list pair_arb in - let canonize_randomly_generated_list = (fun x -> norm_intvs ik x |> fst) in - let shrink xs = GobQCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list - in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) canonize_randomly_generated_list list_pair_arb) -end - -module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct - include D - - let add ?no_ov ik x y = fst @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = fst @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = fst @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = fst @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = fst @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = fst @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = fst @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = fst @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = fst @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = fst @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = fst @@ D.shift_left ik x y - - let shift_right ik x y = fst @@ D.shift_right ik x y -end - -module IntIkind = struct let ikind () = Cil.IInt end -module Interval = IntervalFunctor (IntOps.BigIntOps) -module Interval32 = IntDomWithDefaultIkind (IntDomLifter (SOverflowUnlifter (IntervalFunctor (IntOps.Int64Ops)))) (IntIkind) -module IntervalSet = IntervalSetFunctor (IntOps.BigIntOps) -module Integers (Ints_t : IntOps.IntOps): IkindUnawareS with type t = Ints_t.t and type int_t = Ints_t.t = (* no top/bot, order is <= *) -struct - include Printable.Std - let name () = "integers" - type t = Ints_t.t [@@deriving eq, ord, hash] - type int_t = Ints_t.t - let top () = raise Unknown - let bot () = raise Error - let top_of ik = top () - let bot_of ik = bot () - let show (x: Ints_t.t) = Ints_t.to_string x - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - (* is_top and is_bot are never called, but if they were, the Std impl would raise their exception, so we overwrite them: *) - let is_top _ = false - let is_bot _ = false - - let equal_to i x = if i > x then `Neq else `Top - let leq x y = x <= y - let join x y = if Ints_t.compare x y > 0 then x else y - let widen = join - let meet x y = if Ints_t.compare x y > 0 then y else x - let narrow = meet - - let of_bool x = if x then Ints_t.one else Ints_t.zero - let to_bool' x = x <> Ints_t.zero - let to_bool x = Some (to_bool' x) - let of_int x = x - let to_int x = Some x - - let neg = Ints_t.neg - let add = Ints_t.add (* TODO: signed overflow is undefined behavior! *) - let sub = Ints_t.sub - let mul = Ints_t.mul - let div = Ints_t.div - let rem = Ints_t.rem - let lt n1 n2 = of_bool (n1 < n2) - let gt n1 n2 = of_bool (n1 > n2) - let le n1 n2 = of_bool (n1 <= n2) - let ge n1 n2 = of_bool (n1 >= n2) - let eq n1 n2 = of_bool (n1 = n2) - let ne n1 n2 = of_bool (n1 <> n2) - let lognot = Ints_t.lognot - let logand = Ints_t.logand - let logor = Ints_t.logor - let logxor = Ints_t.logxor - let shift_left n1 n2 = Ints_t.shift_left n1 (Ints_t.to_int n2) - let shift_right n1 n2 = Ints_t.shift_right n1 (Ints_t.to_int n2) - let c_lognot n1 = of_bool (not (to_bool' n1)) - let c_logand n1 n2 = of_bool ((to_bool' n1) && (to_bool' n2)) - let c_logor n1 n2 = of_bool ((to_bool' n1) || (to_bool' n2)) - let cast_to ?(suppress_ovwarn=false) ?torg t x = failwith @@ "Cast_to not implemented for " ^ (name ()) ^ "." - let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 (* TODO: use ikind *) - let invariant _ _ = Invariant.none (* TODO *) -end - -module FlatPureIntegers: IkindUnawareS with type t = int64 and type int_t = int64 = (* Integers, but raises Unknown/Error on join/meet *) -struct - include Integers(IntOps.Int64Ops) - let top () = raise Unknown - let bot () = raise Error - let leq = equal - let pretty_diff () (x,y) = Pretty.dprintf "Integer %a instead of %a" pretty x pretty y - let join x y = if equal x y then x else top () - let meet x y = if equal x y then x else bot () -end - -module Flat (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) -struct - type int_t = Base.int_t - include Lattice.FlatConf (struct - include Printable.DefaultConf - let top_name = "Unknown int" - let bot_name = "Error int" - end) (Base) - - let top_of ik = top () - let bot_of ik = bot () - - - let name () = "flat integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ikind x = top_of ikind - let ending ?(suppress_ovwarn=false) ikind x = top_of ikind - let maximal x = None - let minimal x = None - - let lift1 f x = match x with - | `Lifted x -> - (try `Lifted (f x) with Unknown -> `Top | Error -> `Bot) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> - (try `Lifted (f x y) with Unknown -> `Top | Error -> `Bot) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Lift (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) -struct - include Lattice.LiftPO (struct - include Printable.DefaultConf - let top_name = "MaxInt" - let bot_name = "MinInt" - end) (Base) - type int_t = Base.int_t - let top_of ik = top () - let bot_of ik = bot () - include StdTop (struct type nonrec t = t let top_of = top_of end) - - let name () = "lifted integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let lift1 f x = match x with - | `Lifted x -> `Lifted (f x) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> `Lifted (f x y) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Flattened = Flat (Integers (IntOps.Int64Ops)) -module Lifted = Lift (Integers (IntOps.Int64Ops)) - -module Reverse (Base: IkindUnawareS) = -struct - include Base - include (Lattice.Reverse (Base) : Lattice.S with type t := Base.t) -end - -module BISet = struct - include SetDomain.Make (IntOps.BigIntOps) - let is_singleton s = cardinal s = 1 -end - -(* The module [Exclusion] constains common functionality about handling of exclusion sets between [DefExc] and [Enums] *) -module Exclusion = -struct - module R = Interval32 - (* We use these types for the functions in this module to make the intended meaning more explicit *) - type t = Exc of BISet.t * Interval32.t - type inc = Inc of BISet.t [@@unboxed] - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.succ (Z.add (Z.neg (min_of_range r)) (max_of_range r)) - - let cardinality_BISet s = - Z.of_int (BISet.cardinal s) - - let leq_excl_incl (Exc (xs, r)) (Inc ys) = - (* For a <= b to hold, the cardinalities must fit, i.e. |a| <= |b|, which implies |min_r, max_r| - |xs| <= |ys|. We check this first. *) - let lower_bound_cardinality_a = Z.sub (cardinality_of_range r) (cardinality_BISet xs) in - let card_b = cardinality_BISet ys in - if Z.compare lower_bound_cardinality_a card_b > 0 then - false - else (* The cardinality did fit, so we check for all elements that are represented by range r, whether they are in (xs union ys) *) - let min_a = min_of_range r in - let max_a = max_of_range r in - GobZ.for_all_range (fun el -> BISet.mem el xs || BISet.mem el ys) (min_a, max_a) - - let leq (Exc (xs, r)) (Exc (ys, s)) = - let min_a, max_a = min_of_range r, max_of_range r in - let excluded_check = BISet.for_all (fun y -> BISet.mem y xs || Z.compare y min_a < 0 || Z.compare y max_a > 0) ys in (* if true, then the values ys, that are not in b, also do not occur in a *) - if not excluded_check - then false - else begin (* Check whether all elements that are in the range r, but not in s, are in xs, i.e. excluded. *) - if R.leq r s then true - else begin if Z.compare (cardinality_BISet xs) (Z.sub (cardinality_of_range r) (cardinality_of_range s)) >= 0 (* Check whether the number of excluded elements in a is as least as big as |min_r, max_r| - |min_s, max_s| *) - then - let min_b, max_b = min_of_range s, max_of_range s in - let leq1 = (* check whether the elements in [r_l; s_l-1] are all in xs, i.e. excluded *) - if Z.compare min_a min_b < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (min_a, Z.pred min_b) - else - true - in - let leq2 () = (* check whether the elements in [s_u+1; r_u] are all in xs, i.e. excluded *) - if Z.compare max_b max_a < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (Z.succ max_b, max_a) - else - true - in - leq1 && (leq2 ()) - else - false - end - end -end - -module DefExc : S with type int_t = Z.t = (* definite or set of excluded values *) -struct - module S = BISet - module R = Interval32 (* range for exclusion *) - - (* Ikind used for intervals representing the domain *) - let range_ikind = Cil.IInt - let size t = R.of_interval range_ikind (let a,b = Size.bits_i64 t in Int64.neg a,b) - - - type t = [ - | `Excluded of S.t * R.t - | `Definite of Z.t - | `Bot - ] [@@deriving eq, ord, hash] - type int_t = Z.t - let name () = "def_exc" - - - let top_range = R.of_interval range_ikind (-99L, 99L) (* Since there is no top ikind we use a range that includes both ILongLong [-63,63] and IULongLong [0,64]. Only needed for intermediate range computation on longs. Correct range is set by cast. *) - let top () = `Excluded (S.empty (), top_range) - let bot () = `Bot - let top_of ik = `Excluded (S.empty (), size ik) - let bot_of ik = bot () - - let show x = - let short_size x = "("^R.show x^")" in - match x with - | `Bot -> "Error int" - | `Definite x -> Z.to_string x - (* Print the empty exclusion as if it was a distinct top element: *) - | `Excluded (s,l) when S.is_empty s -> "Unknown int" ^ short_size l - (* Prepend the exclusion sets with something: *) - | `Excluded (s,l) -> "Not " ^ S.show s ^ short_size l - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let maximal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.max_of_range r) - | `Bot -> None - - let minimal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.min_of_range r) - | `Bot -> None - - let in_range r i = - if Z.compare i Z.zero < 0 then - let lowerb = Exclusion.min_of_range r in - Z.compare lowerb i <= 0 - else - let upperb = Exclusion.max_of_range r in - Z.compare i upperb <= 0 - - let is_top x = x = top () - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Definite x -> if i = x then `Eq else `Neq - | `Excluded (s,r) -> if S.mem i s then `Neq else `Top - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik = function - | `Excluded (s,r) -> - let r' = size ik in - if R.leq r r' then (* upcast -> no change *) - `Excluded (s, r) - else if ik = IBool then (* downcast to bool *) - if S.mem Z.zero s then - `Definite Z.one - else - `Excluded (S.empty(), r') - else - (* downcast: may overflow *) - (* let s' = S.map (Size.cast ik) s in *) - (* We want to filter out all i in s' where (t)x with x in r could be i. *) - (* Since this is hard to compute, we just keep all i in s' which overflowed, since those are safe - all i which did not overflow may now be possible due to overflow of r. *) - (* S.diff s' s, r' *) - (* The above is needed for test 21/03, but not sound! See example https://github.com/goblint/analyzer/pull/95#discussion_r483023140 *) - `Excluded (S.empty (), r') - | `Definite x -> `Definite (Size.cast ik x) - | `Bot -> `Bot - - (* Wraps definite values and excluded values according to the ikind. - * For an `Excluded s,r , assumes that r is already an overapproximation of the range of possible values. - * r might be larger than the possible range of this type; the range of the returned `Excluded set will be within the bounds of the ikind. - *) - let norm ik v = - match v with - | `Excluded (s, r) -> - let possibly_overflowed = not (R.leq r (size ik)) || not (S.for_all (in_range (size ik)) s) in - (* If no overflow occurred, just return x *) - if not possibly_overflowed then ( - v - ) - (* Else, if an overflow might have occurred but we should just ignore it *) - else if should_ignore_overflow ik then ( - let r = size ik in - (* filter out excluded elements that are not in the range *) - let mapped_excl = S.filter (in_range r) s in - `Excluded (mapped_excl, r) - ) - (* Else, if an overflow occurred that we should not treat with wrap-around, go to top *) - else if not (should_wrap ik) then ( - top_of ik - ) else ( - (* Else an overflow occurred that we should treat with wrap-around *) - let r = size ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - let mapped_excl = S.map (fun excl -> Size.cast ik excl) s in - match ik with - | IBool -> - begin match S.mem Z.zero mapped_excl, S.mem Z.one mapped_excl with - | false, false -> `Excluded (mapped_excl, r) (* Not {} -> Not {} *) - | true, false -> `Definite Z.one (* Not {0} -> 1 *) - | false, true -> `Definite Z.zero (* Not {1} -> 0 *) - | true, true -> `Bot (* Not {0, 1} -> bot *) - end - | ik -> - `Excluded (mapped_excl, r) - ) - | `Definite x -> - let min, max = Size.range ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - if should_wrap ik then ( - cast_to ik v - ) - else if Z.compare min x <= 0 && Z.compare x max <= 0 then ( - v - ) - else if should_ignore_overflow ik then ( - M.warn ~category:M.Category.Integer.overflow "DefExc: Value was outside of range, indicating overflow, but 'sem.int.signed_overflow' is 'assume_none' -> Returned Bot"; - `Bot - ) - else ( - top_of ik - ) - | `Bot -> `Bot - - let leq x y = match (x,y) with - (* `Bot <= x is always true *) - | `Bot, _ -> true - (* Anything except bot <= bot is always false *) - | _, `Bot -> false - (* Two known values are leq whenever equal *) - | `Definite (x: int_t), `Definite y -> x = y - (* A definite value is leq all exclusion sets that don't contain it *) - | `Definite x, `Excluded (s,r) -> in_range r x && not (S.mem x s) - (* No finite exclusion set can be leq than a definite value *) - | `Excluded (xs, xr), `Definite d -> - Exclusion.(leq_excl_incl (Exc (xs, xr)) (Inc (S.singleton d))) - | `Excluded (xs,xr), `Excluded (ys,yr) -> - Exclusion.(leq (Exc (xs,xr)) (Exc (ys, yr))) - - let join' ?range ik x y = - match (x,y) with - (* The least upper bound with the bottom element: *) - | `Bot, x -> x - | x, `Bot -> x - (* The case for two known values: *) - | `Definite (x: int_t), `Definite y -> - (* If they're equal, it's just THAT value *) - if x = y then `Definite x - (* Unless one of them is zero, we can exclude it: *) - else - let a,b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval range_ikind a) (R.of_interval range_ikind b) in - `Excluded ((if Z.equal x Z.zero || Z.equal y Z.zero then S.empty () else S.singleton Z.zero), r) - (* A known value and an exclusion set... the definite value should no - * longer be excluded: *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> - if not (in_range r x) then - let a = R.of_interval range_ikind (Size.min_range_sign_agnostic x) in - `Excluded (S.remove x s, R.join a r) - else - `Excluded (S.remove x s, r) - (* For two exclusion sets, only their intersection can be excluded: *) - | `Excluded (x,wx), `Excluded (y,wy) -> `Excluded (S.inter x y, range |? R.join wx wy) - - let join ik = join' ik - - - let widen ik x y = - if get_def_exc_widen_by_join () then - join' ik x y - else if equal x y then - x - else - join' ~range:(size ik) ik x y - - - let meet ik x y = - match (x,y) with - (* Greatest LOWER bound with the least element is trivial: *) - | `Bot, _ -> `Bot - | _, `Bot -> `Bot - (* Definite elements are either equal or the glb is bottom *) - | `Definite x, `Definite y -> if x = y then `Definite x else `Bot - (* The glb of a definite element and an exclusion set is either bottom or - * just the element itself, if it isn't in the exclusion set *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> if S.mem x s || not (in_range r x) then `Bot else `Definite x - (* The greatest lower bound of two exclusion sets is their union, this is - * just DeMorgans Law *) - | `Excluded (x,r1), `Excluded (y,r2) -> - let r' = R.meet r1 r2 in - let s' = S.union x y |> S.filter (in_range r') in - `Excluded (s', r') - - let narrow ik x y = x - - let of_int ik x = norm ik @@ `Definite x - let to_int x = match x with - | `Definite x -> Some x - | _ -> None - - let from_excl ikind (s: S.t) = norm ikind @@ `Excluded (s, size ikind) - - let of_bool_cmp ik x = of_int ik (if x then Z.one else Z.zero) - let of_bool = of_bool_cmp - let to_bool x = - match x with - | `Definite x -> Some (IntOps.BigIntOps.to_bool x) - | `Excluded (s,r) when S.mem Z.zero s -> Some true - | _ -> None - let top_bool = `Excluded (S.empty (), R.of_interval range_ikind (0L, 1L)) - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = - if Z.compare x y = 0 then - of_int ik x - else - let a, b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval ~suppress_ovwarn range_ikind a) (R.of_interval ~suppress_ovwarn range_ikind b) in - let ex = if Z.gt x Z.zero || Z.lt y Z.zero then S.singleton Z.zero else S.empty () in - norm ik @@ (`Excluded (ex, r)) - - let starting ?(suppress_ovwarn=false) ikind x = - let _,u_ik = Size.range ikind in - of_interval ~suppress_ovwarn ikind (x, u_ik) - - let ending ?(suppress_ovwarn=false) ikind x = - let l_ik,_ = Size.range ikind in - of_interval ~suppress_ovwarn ikind (l_ik, x) - - let of_excl_list t l = - let r = size t in (* elements in l are excluded from the full range of t! *) - `Excluded (List.fold_right S.add l (S.empty ()), r) - let is_excl_list l = match l with `Excluded _ -> true | _ -> false - let to_excl_list (x:t) = match x with - | `Definite _ -> None - | `Excluded (s,r) -> Some (S.elements s, (Option.get (R.minimal r), Option.get (R.maximal r))) - | `Bot -> None - - let to_incl_list x = match x with - | `Definite x -> Some [x] - | `Excluded _ -> None - | `Bot -> None - - let apply_range f r = (* apply f to the min/max of the old range r to get a new range *) - (* If the Int64 might overflow on us during computation, we instead go to top_range *) - match R.minimal r, R.maximal r with - | _ -> - let rf m = (size % Size.min_for % f) (m r) in - let r1, r2 = rf Exclusion.min_of_range, rf Exclusion.max_of_range in - R.join r1 r2 - - (* Default behaviour for unary operators, simply maps the function to the - * DefExc data structure. *) - let lift1 f ik x = norm ik @@ match x with - | `Excluded (s,r) -> - let s' = S.map f s in - `Excluded (s', apply_range f r) - | `Definite x -> `Definite (f x) - | `Bot -> `Bot - - let lift2 f ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite _ - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (f x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - (* Default behaviour for binary operators that are injective in either - * argument, so that Exclusion Sets can be used: *) - let lift2_inj f ik x y = - let def_exc f x s r = `Excluded (S.map (f x) s, apply_range (f x) r) in - norm ik @@ - match x,y with - (* If both are exclusion sets, there isn't anything we can do: *) - | `Excluded _, `Excluded _ -> top () - (* A definite value should be applied to all members of the exclusion set *) - | `Definite x, `Excluded (s,r) -> def_exc f x s r - (* Same thing here, but we should flip the operator to map it properly *) - | `Excluded (s,r), `Definite x -> def_exc (Batteries.flip f) x s r - (* The good case: *) - | `Definite x, `Definite y -> `Definite (f x y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The equality check: *) - let eq ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x equal to an exclusion set, if it is a member then NO otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt false else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt false else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x = y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The inequality check: *) - let ne ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x unequal to an exclusion set, if it is a member then Yes otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt true else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt true else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x <> y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - let neg ?no_ov ik (x :t) = norm ik @@ lift1 Z.neg ik x - let add ?no_ov ik x y = norm ik @@ lift2_inj Z.add ik x y - - let sub ?no_ov ik x y = norm ik @@ lift2_inj Z.sub ik x y - let mul ?no_ov ik x y = norm ik @@ match x, y with - | `Definite z, (`Excluded _ | `Definite _) when Z.equal z Z.zero -> x - | (`Excluded _ | `Definite _), `Definite z when Z.equal z Z.zero -> y - | `Definite a, `Excluded (s,r) - (* Integer multiplication with even numbers is not injective. *) - (* Thus we cannot exclude the values to which the exclusion set would be mapped to. *) - | `Excluded (s,r),`Definite a when Z.equal (Z.rem a (Z.of_int 2)) Z.zero -> `Excluded (S.empty (), apply_range (Z.mul a) r) - | _ -> lift2_inj Z.mul ik x y - let div ?no_ov ik x y = lift2 Z.div ik x y - let rem ik x y = lift2 Z.rem ik x y - - (* Comparison handling copied from Enums. *) - let handle_bot x y f = match x, y with - | `Bot, `Bot -> `Bot - | `Bot, _ - | _, `Bot -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> f () - - let lt ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 < 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 >= 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let gt ik x y = lt ik y x - - let le ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 <= 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 > 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let ge ik x y = le ik y x - - let lognot = lift1 Z.lognot - - let logand ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite i -> - (* Except in two special cases *) - if Z.equal i Z.zero then - `Definite Z.zero - else if Z.equal i Z.one then - of_interval IBool (Z.zero, Z.one) - else - top () - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (Z.logand x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - - let logor = lift2 Z.logor - let logxor = lift2 Z.logxor - - let shift (shift_op: int_t -> int -> int_t) (ik: Cil.ikind) (x: t) (y: t) = - (* BigInt only accepts int as second argument for shifts; perform conversion here *) - let shift_op_big_int a (b: int_t) = - let (b : int) = Z.to_int b in - shift_op a b - in - (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in - if is_negative (minimal x) || is_negative (minimal y) then - top_of ik - else - norm ik @@ lift2 shift_op_big_int ik x y - - let shift_left = - shift Z.shift_left - - let shift_right = - shift Z.shift_right - (* TODO: lift does not treat Not {0} as true. *) - let c_logand ik x y = - match to_bool x, to_bool y with - | Some false, _ - | _, Some false -> - of_bool ik false - | _, _ -> - lift2 IntOps.BigIntOps.c_logand ik x y - let c_logor ik x y = - match to_bool x, to_bool y with - | Some true, _ - | _, Some true -> - of_bool ik true - | _, _ -> - lift2 IntOps.BigIntOps.c_logor ik x y - let c_lognot ik = eq ik (of_int ik Z.zero) - - let invariant_ikind e ik (x:t) = - match x with - | `Definite x -> - IntInvariant.of_int e ik x - | `Excluded (s, r) -> - (* Emit range invariant if tighter than ikind bounds. - This can be more precise than interval, which has been widened. *) - let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let ri = IntInvariant.of_interval e ik (rmin, rmax) in - let si = IntInvariant.of_excl_list e ik (S.elements s) in - Invariant.(ri && si) - | `Bot -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - let excluded s = from_excl ik s in - let definite x = of_int ik x in - let shrink = function - | `Excluded (s, _) -> GobQCheck.shrink (S.arbitrary ()) s >|= excluded (* S TODO: possibly shrink excluded to definite *) - | `Definite x -> (return `Bot) <+> (GobQCheck.shrink (IntOps.BigIntOps.arbitrary ()) x >|= definite) - | `Bot -> empty - in - QCheck.frequency ~shrink ~print:show [ - 20, QCheck.map excluded (S.arbitrary ()); - 10, QCheck.map definite (IntOps.BigIntOps.arbitrary ()); - 1, QCheck.always `Bot - ] (* S TODO: decide frequencies *) - - let refine_with_congruence ik a b = a - let refine_with_interval ik a b = match a, b with - | x, Some(i) -> meet ik x (of_interval ik i) - | _ -> a - let refine_with_excl_list ik a b = match a, b with - | `Excluded (s, r), Some(ls, _) -> meet ik (`Excluded (s, r)) (of_excl_list ik ls) (* TODO: refine with excl range? *) - | _ -> a - let refine_with_incl_list ik a b = a - - let project ik p t = t -end - -(* 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. *) -module Enums : S with type int_t = Z.t = struct - module R = Interval32 (* range for exclusion *) - - let range_ikind = Cil.IInt - let size t = R.of_interval range_ikind (let a,b = Size.bits_i64 t in Int64.neg a,b) - - type t = Inc of BISet.t | Exc of BISet.t * R.t [@@deriving eq, ord, hash] (* inclusion/exclusion set *) - - type int_t = Z.t - let name () = "enums" - let bot () = failwith "bot () not implemented for Enums" - let top () = failwith "top () not implemented for Enums" - let bot_of ik = Inc (BISet.empty ()) - let top_bool = Inc (BISet.of_list [Z.zero; Z.one]) - let top_of ik = - match ik with - | IBool -> top_bool - | _ -> Exc (BISet.empty (), size ik) - - let range ik = Size.range ik - -(* - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.add (Z.neg (min_of_range r)) (max_of_range r) *) - let value_in_range (min, max) v = Z.compare min v <= 0 && Z.compare v max <= 0 - - let show = function - | Inc xs when BISet.is_empty xs -> "bot" - | Inc xs -> "{" ^ (String.concat ", " (List.map Z.to_string (BISet.elements xs))) ^ "}" - | Exc (xs,r) -> "not {" ^ (String.concat ", " (List.map Z.to_string (BISet.elements xs))) ^ "} " ^ "("^R.show r^")" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - (* Normalization function for enums, that handles overflows for Inc. - As we do not compute on Excl, we do not have to perform any overflow handling for it. *) - let norm ikind v = - let min, max = range ikind in - (* Whether the value v lies within the values of the specified ikind. *) - let value_in_ikind v = - Z.compare min v <= 0 && Z.compare v max <= 0 - in - match v with - | Inc xs when BISet.for_all value_in_ikind xs -> v - | Inc xs -> - if should_wrap ikind then - Inc (BISet.map (Size.cast ikind) xs) - else if should_ignore_overflow ikind then - Inc (BISet.filter value_in_ikind xs) - else - top_of ikind - | Exc (xs, r) -> - (* The following assert should hold for Exc, therefore we do not have to overflow handling / normalization for it: - let range_in_ikind r = - R.leq r (size ikind) - in - let r_min, r_max = min_of_range r, max_of_range r in - assert (range_in_ikind r && BISet.for_all (value_in_range (r_min, r_max)) xs); *) - begin match ikind with - | IBool -> - begin match BISet.mem Z.zero xs, BISet.mem Z.one xs with - | false, false -> top_bool (* Not {} -> {0, 1} *) - | true, false -> Inc (BISet.singleton Z.one) (* Not {0} -> {1} *) - | false, true -> Inc (BISet.singleton Z.zero) (* Not {1} -> {0} *) - | true, true -> bot_of ikind (* Not {0, 1} -> bot *) - end - | _ -> - v - end - - - let equal_to i = function - | Inc x -> - if BISet.mem i x then - if BISet.is_singleton x then `Eq - else `Top - else `Neq - | Exc (x, r) -> - if BISet.mem i x then `Neq - else `Top - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik v = norm ik @@ match v with - | Exc (s,r) -> - let r' = size ik in - if R.leq r r' then (* upcast -> no change *) - Exc (s, r) - else if ik = IBool then (* downcast to bool *) - if BISet.mem Z.zero s then - Inc (BISet.singleton Z.one) - else - Exc (BISet.empty(), r') - else (* downcast: may overflow *) - Exc ((BISet.empty ()), r') - | Inc xs -> - let casted_xs = BISet.map (Size.cast ik) xs in - if Cil.isSigned ik && not (BISet.equal xs casted_xs) - then top_of ik (* When casting into a signed type and the result does not fit, the behavior is implementation-defined *) - else Inc casted_xs - - let of_int ikind x = cast_to ikind (Inc (BISet.singleton x)) - - let of_interval ?(suppress_ovwarn=false) ik (x, y) = - if Z.compare x y = 0 then - of_int ik x - else - let a, b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval ~suppress_ovwarn range_ikind a) (R.of_interval ~suppress_ovwarn range_ikind b) in - let ex = if Z.gt x Z.zero || Z.lt y Z.zero then BISet.singleton Z.zero else BISet.empty () in - norm ik @@ (Exc (ex, r)) - - let join _ x y = - match x, y with - | Inc x, Inc y -> Inc (BISet.union x y) - | Exc (x,r1), Exc (y,r2) -> Exc (BISet.inter x y, R.join r1 r2) - | Exc (x,r), Inc y - | Inc y, Exc (x,r) -> - let r = if BISet.is_empty y - then r - else - let (min_el_range, max_el_range) = Batteries.Tuple2.mapn (fun x -> R.of_interval range_ikind (Size.min_range_sign_agnostic x)) (BISet.min_elt y, BISet.max_elt y) in - let range = R.join min_el_range max_el_range in - R.join r range - in - Exc (BISet.diff x y, r) - - let meet _ x y = - match x, y with - | Inc x, Inc y -> Inc (BISet.inter x y) - | Exc (x,r1), Exc (y,r2) -> - let r = R.meet r1 r2 in - let r_min, r_max = Exclusion.min_of_range r, Exclusion.max_of_range r in - let filter_by_range = BISet.filter (value_in_range (r_min, r_max)) in - (* We remove those elements from the exclusion set that do not fit in the range anyway *) - let excl = BISet.union (filter_by_range x) (filter_by_range y) in - Exc (excl, r) - | Inc x, Exc (y,r) - | Exc (y,r), Inc x -> Inc (BISet.diff x y) - - let widen = join - let narrow = meet - let leq a b = - match a, b with - | Inc xs, Exc (ys, r) -> - if BISet.is_empty xs - then true - else - let min_b, max_b = Exclusion.min_of_range r, Exclusion.max_of_range r in - let min_a, max_a = BISet.min_elt xs, BISet.max_elt xs in - (* Check that the xs fit into the range r *) - Z.compare min_b min_a <= 0 && Z.compare max_a max_b <= 0 && - (* && check that none of the values contained in xs is excluded, i.e. contained in ys. *) - BISet.for_all (fun x -> not (BISet.mem x ys)) xs - | Inc xs, Inc ys -> - BISet.subset xs ys - | Exc (xs, r), Exc (ys, s) -> - Exclusion.(leq (Exc (xs, r)) (Exc (ys, s))) - | Exc (xs, r), Inc ys -> - Exclusion.(leq_excl_incl (Exc (xs, r)) (Inc ys)) - - let handle_bot x y f = match is_bot x, is_bot y with - | false, false -> f () - | true, false - | false, true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | true, true -> Inc (BISet.empty ()) - - let lift1 f ikind v = norm ikind @@ match v with - | Inc x when BISet.is_empty x -> v (* Return bottom when value is bottom *) - | Inc x when BISet.is_singleton x -> Inc (BISet.singleton (f (BISet.choose x))) - | _ -> top_of ikind - - let lift2 f (ikind: Cil.ikind) u v = - handle_bot u v (fun () -> - norm ikind @@ match u, v with - | Inc x,Inc y when BISet.is_singleton x && BISet.is_singleton y -> Inc (BISet.singleton (f (BISet.choose x) (BISet.choose y))) - | _,_ -> top_of ikind) - - let lift2 f ikind a b = - try lift2 f ikind a b with Division_by_zero -> top_of ikind - - let neg ?no_ov = lift1 Z.neg - let add ?no_ov ikind a b = - match a, b with - | Inc z,x when BISet.is_singleton z && BISet.choose z = Z.zero -> x - | x,Inc z when BISet.is_singleton z && BISet.choose z = Z.zero -> x - | x,y -> lift2 Z.add ikind x y - let sub ?no_ov = lift2 Z.sub - let mul ?no_ov ikind a b = - match a, b with - | Inc one,x when BISet.is_singleton one && BISet.choose one = Z.one -> x - | x,Inc one when BISet.is_singleton one && BISet.choose one = Z.one -> x - | Inc zero,_ when BISet.is_singleton zero && BISet.choose zero = Z.zero -> a - | _,Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> b - | x,y -> lift2 Z.mul ikind x y - - let div ?no_ov ikind a b = match a, b with - | x,Inc one when BISet.is_singleton one && BISet.choose one = Z.one -> x - | _,Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> top_of ikind - | Inc zero,_ when BISet.is_singleton zero && BISet.choose zero = Z.zero -> a - | x,y -> lift2 Z.div ikind x y - - let rem = lift2 Z.rem - - let lognot = lift1 Z.lognot - let logand = lift2 Z.logand - let logor = lift2 Z.logor - let logxor = lift2 Z.logxor - - let shift (shift_op: int_t -> int -> int_t) (ik: Cil.ikind) (x: t) (y: t) = - handle_bot x y (fun () -> - (* BigInt only accepts int as second argument for shifts; perform conversion here *) - let shift_op_big_int a (b: int_t) = - let (b : int) = Z.to_int b in - shift_op a b - in - (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in - if is_negative (minimal x) || is_negative (minimal y) then - top_of ik - else - lift2 shift_op_big_int ik x y) - - let shift_left = - shift Z.shift_left - - let shift_right = - shift Z.shift_right - - let of_bool ikind x = Inc (BISet.singleton (if x then Z.one else Z.zero)) - let to_bool = function - | Inc e when BISet.is_empty e -> None - | Exc (e,_) when BISet.is_empty e -> None - | Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> Some false - | Inc xs when BISet.for_all ((<>) Z.zero) xs -> Some true - | Exc (xs,_) when BISet.exists ((=) Z.zero) xs -> Some true - | _ -> None - let to_int = function Inc x when BISet.is_singleton x -> Some (BISet.choose x) | _ -> None - - let to_excl_list = function Exc (x,r) when not (BISet.is_empty x) -> Some (BISet.elements x, (Option.get (R.minimal r), Option.get (R.maximal r))) | _ -> None - let of_excl_list ik xs = - let min_ik, max_ik = Size.range ik in - let exc = BISet.of_list @@ List.filter (value_in_range (min_ik, max_ik)) xs in - norm ik @@ Exc (exc, size ik) - let is_excl_list = BatOption.is_some % to_excl_list - let to_incl_list = function Inc s when not (BISet.is_empty s) -> Some (BISet.elements s) | _ -> None - - let starting ?(suppress_ovwarn=false) ikind x = - let _,u_ik = Size.range ikind in - of_interval ~suppress_ovwarn ikind (x, u_ik) - - let ending ?(suppress_ovwarn=false) ikind x = - let l_ik,_ = Size.range ikind in - of_interval ~suppress_ovwarn ikind (l_ik, x) - - let c_lognot ik x = - if is_bot x - then x - else - match to_bool x with - | Some b -> of_bool ik (not b) - | None -> top_bool - - let c_logand = lift2 IntOps.BigIntOps.c_logand - let c_logor = lift2 IntOps.BigIntOps.c_logor - let maximal = function - | Inc xs when not (BISet.is_empty xs) -> Some (BISet.max_elt xs) - | Exc (excl,r) -> - let rec decrement_while_contained v = - if BISet.mem v excl - then decrement_while_contained (Z.pred v) - else v - in - let range_max = Exclusion.max_of_range r in - Some (decrement_while_contained range_max) - | _ (* bottom case *) -> None - - let minimal = function - | Inc xs when not (BISet.is_empty xs) -> Some (BISet.min_elt xs) - | Exc (excl,r) -> - let rec increment_while_contained v = - if BISet.mem v excl - then increment_while_contained (Z.succ v) - else v - in - let range_min = Exclusion.min_of_range r in - Some (increment_while_contained range_min) - | _ (* bottom case *) -> None - - let lt ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 < 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 >= 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let gt ik x y = lt ik y x - - let le ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 <= 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 > 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let ge ik x y = le ik y x - - let eq ik x y = - handle_bot x y (fun () -> - match x, y with - | Inc xs, Inc ys when BISet.is_singleton xs && BISet.is_singleton ys -> of_bool ik (Z.equal (BISet.choose xs) (BISet.choose ys)) - | _, _ -> - if is_bot (meet ik x y) then - (* If the meet is empty, there is no chance that concrete values are equal *) - of_bool ik false - else - top_bool) - - let ne ik x y = c_lognot ik (eq ik x y) - - let invariant_ikind e ik x = - match x with - | Inc ps -> - IntInvariant.of_incl_list e ik (BISet.elements ps) - | Exc (ns, r) -> - (* Emit range invariant if tighter than ikind bounds. - This can be more precise than interval, which has been widened. *) - let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let ri = IntInvariant.of_interval e ik (rmin, rmax) in - let nsi = IntInvariant.of_excl_list e ik (BISet.elements ns) in - Invariant.(ri && nsi) - - - let arbitrary ik = - let open QCheck.Iter in - let neg s = of_excl_list ik (BISet.elements s) in - let pos s = norm ik (Inc s) in - let shrink = function - | Exc (s, _) -> GobQCheck.shrink (BISet.arbitrary ()) s >|= neg (* S TODO: possibly shrink neg to pos *) - | Inc s -> GobQCheck.shrink (BISet.arbitrary ()) s >|= pos - in - QCheck.frequency ~shrink ~print:show [ - 20, QCheck.map neg (BISet.arbitrary ()); - 10, QCheck.map pos (BISet.arbitrary ()); - ] (* S TODO: decide frequencies *) - - let refine_with_congruence ik a b = - let contains c m x = if Z.equal m Z.zero then Z.equal c x else Z.equal (Z.rem (Z.sub x c) m) Z.zero in - match a, b with - | Inc e, None -> bot_of ik - | Inc e, Some (c, m) -> Inc (BISet.filter (contains c m) e) - | _ -> a - - let refine_with_interval ik a b = a (* TODO: refine inclusion (exclusion?) set *) - - let refine_with_excl_list ik a b = - match b with - | Some (ls, _) -> meet ik a (of_excl_list ik ls) (* TODO: refine with excl range? *) - | _ -> a - - let refine_with_incl_list ik a b = - match a, b with - | Inc x, Some (ls) -> meet ik (Inc x) (Inc (BISet.of_list ls)) - | _ -> a - - let project ik p t = t -end - -module Congruence : S with type int_t = Z.t and type t = (Z.t * Z.t) option = -struct - let name () = "congruences" - type int_t = Z.t - - (* represents congruence class of c mod m, None is bot *) - type t = (Z.t * Z.t) option [@@deriving eq, ord, hash] - - let ( *: ) = Z.mul - let (+:) = Z.add - let (-:) = Z.sub - let (%:) = Z.rem - let (/:) = Z.div - let (=:) = Z.equal - let (<:) x y = Z.compare x y < 0 - let (>:) x y = Z.compare x y > 0 - let (<=:) x y = Z.compare x y <= 0 - let (>=:) x y = Z.compare x y >= 0 - (* a divides b *) - let ( |: ) a b = - if a =: Z.zero then false else (b %: a) =: Z.zero - - let normalize ik x = - match x with - | None -> None - | Some (c, m) -> - if m =: Z.zero then - if should_wrap ik then - Some (Size.cast ik c, m) - else - Some (c, m) - else - let m' = Z.abs m in - let c' = c %: m' in - if c' <: Z.zero then - Some (c' +: m', m') - else - Some (c' %: m', m') - - let range ik = Size.range ik - - let top () = Some (Z.zero, Z.one) - let top_of ik = Some (Z.zero, Z.one) - let bot () = None - let bot_of ik = bot () - - let show = function ik -> match ik with - | None -> "⟂" - | Some (c, m) when (c, m) = (Z.zero, Z.zero) -> Z.to_string c - | Some (c, m) -> - let a = if c =: Z.zero then "" else Z.to_string c in - let b = if m =: Z.zero then "" else if m = Z.one then "ℤ" else Z.to_string m^"ℤ" in - let c = if a = "" || b = "" then "" else "+" in - a^c^b - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let is_top x = x = top () - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) when b =: Z.zero -> if a =: i then `Eq else `Neq - | Some (a, b) -> if i %: b =: a then `Top else `Neq - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (c1,m1), Some (c2,m2) when m2 =: Z.zero && m1 =: Z.zero -> c1 =: c2 - | Some (c1,m1), Some (c2,m2) when m2 =: Z.zero -> c1 =: c2 && m1 =: Z.zero - | Some (c1,m1), Some (c2,m2) -> m2 |: Z.gcd (c1 -: c2) m1 - (* Typo in original equation of P. Granger (m2 instead of m1): gcd (c1 -: c2) m2 - Reference: https://doi.org/10.1080/00207168908803778 Page 171 corollary 3.3*) - - let leq x y = - let res = leq x y in - if M.tracing then M.trace "congruence" "leq %a %a -> %a " pretty x pretty y pretty (Some (Z.of_int (Bool.to_int res), Z.zero)) ; - res - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (c1,m1), Some (c2,m2) -> - let m3 = Z.gcd m1 (Z.gcd m2 (c1 -: c2)) in - normalize ik (Some (c1, m3)) - - let join ik (x:t) y = - let res = join ik x y in - if M.tracing then M.trace "congruence" "join %a %a -> %a" pretty x pretty y pretty res; - res - - - let meet ik x y = - (* if it exists, c2/a2 is solution to a*x ≡ c (mod m) *) - let congruence_series a c m = - let rec next a1 c1 a2 c2 = - if a2 |: a1 then (a2, c2) - else next a2 c2 (a1 %: a2) (c1 -: (c2 *: (a1 /: a2))) - in next m Z.zero a c - in - let simple_case i c m = - if m |: (i -: c) - then Some (i, Z.zero) else None - in - match x, y with - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero && m2 =: Z.zero -> if c1 =: c2 then Some (c1, Z.zero) else None - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero -> simple_case c1 c2 m2 - | Some (c1, m1), Some (c2, m2) when m2 =: Z.zero -> simple_case c2 c1 m1 - | Some (c1, m1), Some (c2, m2) when (Z.gcd m1 m2) |: (c1 -: c2) -> - let (c, m) = congruence_series m1 (c2 -: c1 ) m2 in - normalize ik (Some(c1 +: (m1 *: (m /: c)), m1 *: (m2 /: c))) - | _ -> None - - let meet ik x y = - let res = meet ik x y in - if M.tracing then M.trace "congruence" "meet %a %a -> %a" pretty x pretty y pretty res; - res - - let to_int = function Some (c, m) when m =: Z.zero -> Some c | _ -> None - let of_int ik (x: int_t) = normalize ik @@ Some (x, Z.zero) - let zero = Some (Z.zero, Z.zero) - let one = Some (Z.one, Z.zero) - let top_bool = top() - - let of_bool _ik = function true -> one | false -> zero - - let to_bool (a: t) = match a with - | None -> None - | x when equal zero x -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = top() - - let ending = starting - - let of_congruence ik (c,m) = normalize ik @@ Some(c,m) - - let maximal t = match t with - | Some (x, y) when y =: Z.zero -> Some x - | _ -> None - - let minimal t = match t with - | Some (x,y) when y =: Z.zero -> Some x - | _ -> None - - (* cast from original type to ikind, set to top if the value doesn't fit into the new type *) - let cast_to ?(suppress_ovwarn=false) ?torg ?(no_ov=false) t x = - match x with - | None -> None - | Some (c, m) when m =: Z.zero -> - let c' = Size.cast t c in - (* When casting into a signed type and the result does not fit, the behavior is implementation-defined. (C90 6.2.1.2, C99 and C11 6.3.1.3) *) - (* We go with GCC behavior here: *) - (* For conversion to a type of width N, the value is reduced modulo 2^N to be within range of the type; no signal is raised. *) - (* (https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html) *) - (* Clang behaves the same but they never document that anywhere *) - Some (c', m) - | _ -> - let (min_t, max_t) = range t in - let p ikorg = - let (min_ikorg, max_ikorg) = range ikorg in - ikorg = t || (max_t >=: max_ikorg && min_t <=: min_ikorg) - in - match torg with - | Some (Cil.TInt (ikorg, _)) when p ikorg -> - if M.tracing then M.trace "cong-cast" "some case"; - x - | _ -> top () - - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov (t : Cil.ikind) x = - let pretty_bool _ x = Pretty.text (string_of_bool x) in - let res = cast_to ?torg ?no_ov t x in - if M.tracing then M.trace "cong-cast" "Cast %a to %a (no_ov: %a) = %a" pretty x Cil.d_ikind t (Pretty.docOpt (pretty_bool ())) no_ov pretty res; - res - - let widen = join - - let widen ik x y = - let res = widen ik x y in - if M.tracing then M.trace "congruence" "widen %a %a -> %a" pretty x pretty y pretty res; - res - - let narrow = meet - - let log f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) - let c_logand = log (&&) - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let shift_right _ _ _ = top() - - let shift_right ik x y = - let res = shift_right ik x y in - if M.tracing then M.trace "congruence" "shift_right : %a %a becomes %a " pretty x pretty y pretty res; - res - - let shift_left ik x y = - (* Naive primality test *) - (* let is_prime n = - let n = Z.abs n in - let rec is_prime' d = - (d *: d >: n) || ((not ((n %: d) =: Z.zero)) && (is_prime' [@tailcall]) (d +: Z.one)) - in - not (n =: Z.one) && is_prime' (Z.of_int 2) - in *) - match x, y with - | None, None -> None - | None, _ - | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c, m), Some (c', m') when Cil.isSigned ik || c <: Z.zero || c' <: Z.zero -> top_of ik - | Some (c, m), Some (c', m') -> - let (_, max_ik) = range ik in - if m =: Z.zero && m' =: Z.zero then - normalize ik @@ Some (Z.logand max_ik (Z.shift_left c (Z.to_int c')), Z.zero) - else - let x = Z.logand max_ik (Z.shift_left Z.one (Z.to_int c')) in (* 2^c' *) - (* TODO: commented out because fails test with _Bool *) - (* if is_prime (m' +: Z.one) then - normalize ik @@ Some (x *: c, Z.gcd (x *: m) ((c *: x) *: (m' +: Z.one))) - else *) - normalize ik @@ Some (x *: c, Z.gcd (x *: m) (c *: x)) - - let shift_left ik x y = - let res = shift_left ik x y in - if M.tracing then M.trace "congruence" "shift_left : %a %a becomes %a " pretty x pretty y pretty res; - res - - (* Handle unsigned overflows. - From n === k mod (2^a * b), we conclude n === k mod 2^a, for a <= bitwidth. - The congruence modulo b may not persist on an overflow. *) - let handle_overflow ik (c, m) = - if m =: Z.zero then - normalize ik (Some (c, m)) - else - (* Find largest m'=2^k (for some k) such that m is divisible by m' *) - let tz = Z.trailing_zeros m in - let m' = Z.shift_left Z.one tz in - - let max = (snd (Size.range ik)) +: Z.one in - if m' >=: max then - (* if m' >= 2 ^ {bitlength}, there is only one value in range *) - let c' = c %: max in - Some (c', Z.zero) - else - normalize ik (Some (c, m')) - - let mul ?(no_ov=false) ik x y = - let no_ov_case (c1, m1) (c2, m2) = - c1 *: c2, Z.gcd (c1 *: m2) (Z.gcd (m1 *: c2) (m1 *: m2)) - in - match x, y with - | None, None -> bot () - | None, _ | _, None -> - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c1, m1), Some (c2, m2) when no_ov -> - Some (no_ov_case (c1, m1) (c2, m2)) - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero && m2 =: Z.zero && not (Cil.isSigned ik) -> - let (_, max_ik) = range ik in - Some ((c1 *: c2) %: (max_ik +: Z.one), Z.zero) - | Some a, Some b when not (Cil.isSigned ik) -> - handle_overflow ik (no_ov_case a b ) - | _ -> top () - - let mul ?no_ov ik x y = - let res = mul ?no_ov ik x y in - if M.tracing then M.trace "congruence" "mul : %a %a -> %a " pretty x pretty y pretty res; - res - - let neg ?(no_ov=false) ik x = - match x with - | None -> bot() - | Some _ -> mul ~no_ov ik (of_int ik (Z.of_int (-1))) x - - let add ?(no_ov=false) ik x y = - let no_ov_case (c1, m1) (c2, m2) = - c1 +: c2, Z.gcd m1 m2 - in - match (x, y) with - | None, None -> bot () - | None, _ | _, None -> - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some a, Some b when no_ov -> - normalize ik (Some (no_ov_case a b)) - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero && m2 =: Z.zero && not (Cil.isSigned ik) -> - let (_, max_ik) = range ik in - Some((c1 +: c2) %: (max_ik +: Z.one), Z.zero) - | Some a, Some b when not (Cil.isSigned ik) -> - handle_overflow ik (no_ov_case a b) - | _ -> top () - - - let add ?no_ov ik x y = - let res = add ?no_ov ik x y in - if M.tracing then - M.trace "congruence" "add : %a %a -> %a" pretty x pretty y - pretty res ; - res - - let sub ?(no_ov=false) ik x y = add ~no_ov ik x (neg ~no_ov ik y) - - - let sub ?no_ov ik x y = - let res = sub ?no_ov ik x y in - if M.tracing then - M.trace "congruence" "sub : %a %a -> %a" pretty x pretty y - pretty res ; - res - - let lognot ik x = match x with - | None -> None - | Some (c, m) -> - if (Cil.isSigned ik) then - sub ik (neg ik x) one - else - let (_, max_ik) = range ik in - Some (Z.sub max_ik c, m) - - (** The implementation of the bit operations could be improved based on the master’s thesis - 'Abstract Interpretation and Abstract Domains' written by Stefan Bygde. - see: http://www.es.mdh.se/pdf_publications/948.pdf *) - let bit2 f ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c, m), Some (c', m') -> - if m =: Z.zero && m' =: Z.zero then Some (f c c', Z.zero) - else top () - - let logor ik x y = bit2 Z.logor ik x y - - let logand ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c, m), Some (c', m') -> - if m =: Z.zero && m' =: Z.zero then - (* both arguments constant *) - Some (Z.logand c c', Z.zero) - else if m' =: Z.zero && c' =: Z.one && Z.rem m (Z.of_int 2) =: Z.zero then - (* x & 1 and x == c (mod 2*z) *) - (* Value is equal to LSB of c *) - Some (Z.logand c c', Z.zero) - else - top () - - let logxor ik x y = bit2 Z.logxor ik x y - - let rem ik x y = - match x, y with - | None, None -> bot() - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c1, m1), Some(c2, m2) -> - if m2 =: Z.zero then - if (c2 |: m1) && (c1 %: c2 =: Z.zero || m1 =: Z.zero || not (Cil.isSigned ik)) then - Some (c1 %: c2, Z.zero) - else - normalize ik (Some (c1, (Z.gcd m1 c2))) - else - normalize ik (Some (c1, Z.gcd m1 (Z.gcd c2 m2))) - - let rem ik x y = let res = rem ik x y in - if M.tracing then M.trace "congruence" "rem : %a %a -> %a " pretty x pretty y pretty res; - res - - let div ?(no_ov=false) ik x y = - match x,y with - | None, None -> bot () - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, x when leq zero x -> top () - | Some(c1, m1), Some(c2, m2) when not no_ov && m2 =: Z.zero && c2 =: Z.neg Z.one -> top () - | Some(c1, m1), Some(c2, m2) when m1 =: Z.zero && m2 =: Z.zero -> Some (c1 /: c2, Z.zero) - | Some(c1, m1), Some(c2, m2) when m2 =: Z.zero && c2 |: m1 && c2 |: c1 -> Some (c1 /: c2, m1 /: c2) - | _, _ -> top () - - - let div ?no_ov ik x y = - let res = div ?no_ov ik x y in - if M.tracing then - M.trace "congruence" "div : %a %a -> %a" pretty x pretty y pretty - res ; - res - - let ne ik (x: t) (y: t) = match x, y with - | Some (c1, m1), Some (c2, m2) when (m1 =: Z.zero) && (m2 =: Z.zero) -> of_bool ik (not (c1 =: c2 )) - | x, y -> if meet ik x y = None then of_bool ik true else top_bool - - let eq ik (x: t) (y: t) = match x, y with - | Some (c1, m1), Some (c2, m2) when (m1 =: Z.zero) && (m2 =: Z.zero) -> of_bool ik (c1 =: c2) - | x, y -> if meet ik x y <> None then top_bool else of_bool ik false - - let comparison ik op x y = match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c1, m1), Some (c2, m2) -> - if m1 =: Z.zero && m2 =: Z.zero then - if op c1 c2 then of_bool ik true else of_bool ik false - else - top_bool - - let ge ik x y = comparison ik (>=:) x y - - let ge ik x y = - let res = ge ik x y in - if M.tracing then M.trace "congruence" "greater or equal : %a %a -> %a " pretty x pretty y pretty res; - res - - let le ik x y = comparison ik (<=:) x y - - let le ik x y = - let res = le ik x y in - if M.tracing then M.trace "congruence" "less or equal : %a %a -> %a " pretty x pretty y pretty res; - res - - let gt ik x y = comparison ik (>:) x y - - - let gt ik x y = - let res = gt ik x y in - if M.tracing then M.trace "congruence" "greater than : %a %a -> %a " pretty x pretty y pretty res; - res - - let lt ik x y = comparison ik (<:) x y - - let lt ik x y = - let res = lt ik x y in - if M.tracing then M.trace "congruence" "less than : %a %a -> %a " pretty x pretty y pretty res; - res - - let invariant_ikind e ik x = - match x with - | x when is_top x -> Invariant.top () - | Some (c, m) when m =: Z.zero -> - IntInvariant.of_int e ik c - | Some (c, m) -> - let open Cil in - let (c, m) = BatTuple.Tuple2.mapn (fun a -> kintegerCilint ik a) (c, m) in - Invariant.of_exp (BinOp (Eq, (BinOp (Mod, e, m, TInt(ik,[]))), c, intType)) - | None -> Invariant.none - - let arbitrary ik = - let open QCheck in - let int_arb = map ~rev:Z.to_int64 Z.of_int64 GobQCheck.Arbitrary.int64 in - let cong_arb = pair int_arb int_arb in - let of_pair ik p = normalize ik (Some p) in - let to_pair = Option.get in - set_print show (map ~rev:to_pair (of_pair ik) cong_arb) - - let refine_with_interval ik (cong : t) (intv : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if m =: Z.zero then - if c <: x || c >: y then None else Some (c, Z.zero) - else - let rcx = x +: ((c -: x) %: Z.abs m) in - let lcy = y -: ((y -: c) %: Z.abs m) in - if rcx >: lcy then None - else if rcx =: lcy then Some (rcx, Z.zero) - else cong - | _ -> None - - let refine_with_interval ik (cong : t) (intv : (int_t * int_t) option) : t = - let pretty_intv _ i = - match i with - | Some (l, u) -> Pretty.dprintf "[%a,%a]" GobZ.pretty l GobZ.pretty u - | _ -> Pretty.text ("Display Error") in - let refn = refine_with_interval ik cong intv in - if M.tracing then M.trace "refine" "cong_refine_with_interval %a %a -> %a" pretty cong pretty_intv intv pretty refn; - refn - - let refine_with_congruence ik a b = meet ik a b - let refine_with_excl_list ik a b = a - let refine_with_incl_list ik a b = a - - let project ik p t = t -end - -module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct - - include D - - let lift v = (v, {overflow=false; underflow=false}) - - let add ?no_ov ik x y = lift @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = lift @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = lift @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = lift @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = lift @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = lift @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = lift @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = lift @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = lift @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = lift @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = lift @@ D.shift_left ik x y - - let shift_right ik x y = lift @@ D.shift_right ik x y - -end - +open IntDomain0 (* The old IntDomList had too much boilerplate since we had to edit every function in S when adding a new domain. With the following, we only have to edit the places where fn are applied, i.e., create, mapp, map, map2. You can search for I3 below to see where you need to extend. *) From 816809fcfcf7fb6fab2c79d43fe47940f0a9af91 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:49:35 +0300 Subject: [PATCH 101/157] Remove IntDomTuple from IntDomain0 --- src/cdomain/value/cdomains/intDomain0.ml | 516 ----------------------- 1 file changed, 516 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/intDomain0.ml index f4639d4522..7450e8a212 100644 --- a/src/cdomain/value/cdomains/intDomain0.ml +++ b/src/cdomain/value/cdomains/intDomain0.ml @@ -3267,519 +3267,3 @@ module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t let shift_right ik x y = lift @@ D.shift_right ik x y end - - - -(* The old IntDomList had too much boilerplate since we had to edit every function in S when adding a new domain. With the following, we only have to edit the places where fn are applied, i.e., create, mapp, map, map2. You can search for I3 below to see where you need to extend. *) -(* discussion: https://github.com/goblint/analyzer/pull/188#issuecomment-818928540 *) -module IntDomTupleImpl = struct - include Printable.Std (* for default invariant, tag, ... *) - - open Batteries - type int_t = Z.t - module I1 = SOverflowLifter (DefExc) - module I2 = Interval - module I3 = SOverflowLifter (Enums) - module I4 = SOverflowLifter (Congruence) - module I5 = IntervalSetFunctor (IntOps.BigIntOps) - - type t = I1.t option * I2.t option * I3.t option * I4.t option * I5.t option - [@@deriving eq, ord, hash] - - let name () = "intdomtuple" - - (* The Interval domain can lead to too many contexts for recursive functions (top is [min,max]), but we don't want to drop all ints as with `ana.base.context.int`. TODO better solution? *) - let no_interval = Tuple5.map2 (const None) - let no_intervalSet = Tuple5.map5 (const None) - - type 'a m = (module SOverflow with type t = 'a) - type 'a m2 = (module SOverflow with type t = 'a and type int_t = int_t ) - - (* only first-order polymorphism on functions -> use records to get around monomorphism restriction on arguments *) - type 'b poly_in = { fi : 'a. 'a m -> 'b -> 'a } [@@unboxed] (* inject *) - type 'b poly2_in = { fi2 : 'a. 'a m2 -> 'b -> 'a } [@@unboxed] (* inject for functions that depend on int_t *) - type 'b poly2_in_ovc = { fi2_ovc : 'a. 'a m2 -> 'b -> 'a * overflow_info} [@@unboxed] (* inject for functions that depend on int_t *) - - type 'b poly_pr = { fp : 'a. 'a m -> 'a -> 'b } [@@unboxed] (* project *) - type 'b poly_pr2 = { fp2 : 'a. 'a m2 -> 'a -> 'b } [@@unboxed] (* project for functions that depend on int_t *) - type 'b poly2_pr = {f2p: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'b} [@@unboxed] - type poly1 = {f1: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a} [@@unboxed] (* needed b/c above 'b must be different from 'a *) - type poly1_ovc = {f1_ovc: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a * overflow_info } [@@unboxed] (* needed b/c above 'b must be different from 'a *) - type poly2 = {f2: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'a} [@@unboxed] - type poly2_ovc = {f2_ovc: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'a * overflow_info } [@@unboxed] - type 'b poly3 = { f3: 'a. 'a m -> 'a option } [@@unboxed] (* used for projection to given precision *) - let create r x ((p1, p2, p3, p4, p5): int_precision) = - let f b g = if b then Some (g x) else None in - f p1 @@ r.fi (module I1), f p2 @@ r.fi (module I2), f p3 @@ r.fi (module I3), f p4 @@ r.fi (module I4), f p5 @@ r.fi (module I5) - let create r x = (* use where values are introduced *) - create r x (int_precision_from_node_or_config ()) - let create2 r x ((p1, p2, p3, p4, p5): int_precision) = - let f b g = if b then Some (g x) else None in - f p1 @@ r.fi2 (module I1), f p2 @@ r.fi2 (module I2), f p3 @@ r.fi2 (module I3), f p4 @@ r.fi2 (module I4), f p5 @@ r.fi2 (module I5) - let create2 r x = (* use where values are introduced *) - create2 r x (int_precision_from_node_or_config ()) - - let no_overflow ik = function - | Some(_, {underflow; overflow}) -> not (underflow || overflow) - | _ -> false - - let check_ov ?(suppress_ovwarn = false) ~cast ik intv intv_set = - let no_ov = (no_overflow ik intv) || (no_overflow ik intv_set) in - if not no_ov && not suppress_ovwarn && ( BatOption.is_some intv || BatOption.is_some intv_set) then ( - let (_,{underflow=underflow_intv; overflow=overflow_intv}) = match intv with None -> (I2.bot (), {underflow= true; overflow = true}) | Some x -> x in - let (_,{underflow=underflow_intv_set; overflow=overflow_intv_set}) = match intv_set with None -> (I5.bot (), {underflow= true; overflow = true}) | Some x -> x in - let underflow = underflow_intv && underflow_intv_set in - let overflow = overflow_intv && overflow_intv_set in - set_overflow_flag ~cast ~underflow ~overflow ik; - ); - no_ov - - let create2_ovc ik r x ((p1, p2, p3, p4, p5): int_precision) = - let f b g = if b then Some (g x) else None in - let map x = Option.map fst x in - let intv = f p2 @@ r.fi2_ovc (module I2) in - let intv_set = f p5 @@ r.fi2_ovc (module I5) in - ignore (check_ov ~cast:false ik intv intv_set); - map @@ f p1 @@ r.fi2_ovc (module I1), map @@ f p2 @@ r.fi2_ovc (module I2), map @@ f p3 @@ r.fi2_ovc (module I3), map @@ f p4 @@ r.fi2_ovc (module I4), map @@ f p5 @@ r.fi2_ovc (module I5) - - let create2_ovc ik r x = (* use where values are introduced *) - create2_ovc ik r x (int_precision_from_node_or_config ()) - - - let opt_map2 f ?no_ov = - curry @@ function Some x, Some y -> Some (f ?no_ov x y) | _ -> None - - let to_list x = Tuple5.enum x |> List.of_enum |> List.filter_map identity (* contains only the values of activated domains *) - let to_list_some x = List.filter_map identity @@ to_list x (* contains only the Some-values of activated domains *) - - let exists = function - | (Some true, _, _, _, _) - | (_, Some true, _, _, _) - | (_, _, Some true, _, _) - | (_, _, _, Some true, _) - | (_, _, _, _, Some true) -> - true - | _ -> - false - - let for_all = function - | (Some false, _, _, _, _) - | (_, Some false, _, _, _) - | (_, _, Some false, _, _) - | (_, _, _, Some false, _) - | (_, _, _, _, Some false) -> - false - | _ -> - true - - (* f0: constructors *) - let top () = create { fi = fun (type a) (module I:SOverflow with type t = a) -> I.top } () - let bot () = create { fi = fun (type a) (module I:SOverflow with type t = a) -> I.bot } () - let top_of = create { fi = fun (type a) (module I:SOverflow with type t = a) -> I.top_of } - let bot_of = create { fi = fun (type a) (module I:SOverflow with type t = a) -> I.bot_of } - let of_bool ik = create { fi = fun (type a) (module I:SOverflow with type t = a) -> I.of_bool ik } - let of_excl_list ik = create2 { fi2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.of_excl_list ik} - let of_int ik = create2_ovc ik { fi2_ovc = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.of_int ik } - let starting ?(suppress_ovwarn=false) ik = create2_ovc ik { fi2_ovc = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.starting ~suppress_ovwarn ik } - let ending ?(suppress_ovwarn=false) ik = create2_ovc ik { fi2_ovc = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.ending ~suppress_ovwarn ik } - let of_interval ?(suppress_ovwarn=false) ik = create2_ovc ik { fi2_ovc = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.of_interval ~suppress_ovwarn ik } - let of_congruence ik = create2 { fi2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.of_congruence ik } - - let refine_with_congruence ik ((a, b, c, d, e) : t) (cong : (int_t * int_t) option) : t= - let opt f a = - curry @@ function Some x, y -> Some (f a x y) | _ -> None - in - ( opt I1.refine_with_congruence ik a cong - , opt I2.refine_with_congruence ik b cong - , opt I3.refine_with_congruence ik c cong - , opt I4.refine_with_congruence ik d cong - , opt I5.refine_with_congruence ik e cong) - - let refine_with_interval ik (a, b, c, d, e) intv = - let opt f a = - curry @@ function Some x, y -> Some (f a x y) | _ -> None - in - ( opt I1.refine_with_interval ik a intv - , opt I2.refine_with_interval ik b intv - , opt I3.refine_with_interval ik c intv - , opt I4.refine_with_interval ik d intv - , opt I5.refine_with_interval ik e intv ) - - let refine_with_excl_list ik (a, b, c, d, e) excl = - let opt f a = - curry @@ function Some x, y -> Some (f a x y) | _ -> None - in - ( opt I1.refine_with_excl_list ik a excl - , opt I2.refine_with_excl_list ik b excl - , opt I3.refine_with_excl_list ik c excl - , opt I4.refine_with_excl_list ik d excl - , opt I5.refine_with_excl_list ik e excl ) - - let refine_with_incl_list ik (a, b, c, d, e) incl = - let opt f a = - curry @@ function Some x, y -> Some (f a x y) | _ -> None - in - ( opt I1.refine_with_incl_list ik a incl - , opt I2.refine_with_incl_list ik b incl - , opt I3.refine_with_incl_list ik c incl - , opt I4.refine_with_incl_list ik d incl - , opt I5.refine_with_incl_list ik e incl ) - - - let mapp r (a, b, c, d, e) = - let map = BatOption.map in - ( map (r.fp (module I1)) a - , map (r.fp (module I2)) b - , map (r.fp (module I3)) c - , map (r.fp (module I4)) d - , map (r.fp (module I5)) e) - - - let mapp2 r (a, b, c, d, e) = - BatOption. - ( map (r.fp2 (module I1)) a - , map (r.fp2 (module I2)) b - , map (r.fp2 (module I3)) c - , map (r.fp2 (module I4)) d - , map (r.fp2 (module I5)) e) - - - (* exists/for_all *) - let is_bot = exists % mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.is_bot } - let is_top = for_all % mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.is_top } - let is_top_of ik = for_all % mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.is_top_of ik } - let is_excl_list = exists % mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.is_excl_list } - - let map2p r (xa, xb, xc, xd, xe) (ya, yb, yc, yd, ye) = - ( opt_map2 (r.f2p (module I1)) xa ya - , opt_map2 (r.f2p (module I2)) xb yb - , opt_map2 (r.f2p (module I3)) xc yc - , opt_map2 (r.f2p (module I4)) xd yd - , opt_map2 (r.f2p (module I5)) xe ye) - - (* f2p: binary projections *) - let (%%) f g x = f % (g x) (* composition for binary function g *) - - let leq = - for_all - %% map2p {f2p= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.leq)} - - let flat f x = match to_list_some x with [] -> None | xs -> Some (f xs) - - let to_excl_list x = - let merge ps = - let (vs, rs) = List.split ps in - let (mins, maxs) = List.split rs in - (List.concat vs |> List.sort_uniq Z.compare, (List.min mins, List.max maxs)) - in - mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.to_excl_list } x |> flat merge - - let to_incl_list x = - let hd l = match l with h::t -> h | _ -> [] in - let tl l = match l with h::t -> t | _ -> [] in - let a y = BatSet.of_list (hd y) in - let b y = BatList.map BatSet.of_list (tl y) in - let merge y = BatSet.elements @@ BatList.fold BatSet.intersect (a y) (b y) - in - mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.to_incl_list } x |> flat merge - - let same show x = let xs = to_list_some x in let us = List.unique xs in let n = List.length us in - if n = 1 then Some (List.hd xs) - else ( - if n>1 then Messages.info ~category:Unsound "Inconsistent state! %a" (Pretty.docList ~sep:(Pretty.text ",") (Pretty.text % show)) us; (* do not want to abort *) - None - ) - let to_int = same Z.to_string % mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.to_int } - - let pretty () x = - match to_int x with - | Some v when not (GobConfig.get_bool "dbg.full-output") -> Pretty.text (Z.to_string v) - | _ -> - mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> (* assert sf==I.short; *) I.pretty () } x - |> to_list - |> (fun xs -> - text "(" ++ ( - try - List.reduce (fun a b -> a ++ text "," ++ b) xs - with Invalid_argument _ -> - nil) - ++ text ")") (* NOTE: the version above does something else. also, we ignore the sf-argument here. *) - - let refine_functions ik : (t -> t) list = - let maybe reffun ik domtup dom = - match dom with Some y -> reffun ik domtup y | _ -> domtup - in - [(fun (a, b, c, d, e) -> refine_with_excl_list ik (a, b, c, d, e) (to_excl_list (a, b, c, d, e))); - (fun (a, b, c, d, e) -> refine_with_incl_list ik (a, b, c, d, e) (to_incl_list (a, b, c, d, e))); - (fun (a, b, c, d, e) -> maybe refine_with_interval ik (a, b, c, d, e) b); (* TODO: get interval across all domains with minimal and maximal *) - (fun (a, b, c, d, e) -> maybe refine_with_congruence ik (a, b, c, d, e) d)] - - let refine ik ((a, b, c, d, e) : t ) : t = - let dt = ref (a, b, c, d, e) in - (match get_refinement () with - | "never" -> () - | "once" -> - List.iter (fun f -> dt := f !dt) (refine_functions ik); - | "fixpoint" -> - let quit_loop = ref false in - while not !quit_loop do - let old_dt = !dt in - List.iter (fun f -> dt := f !dt) (refine_functions ik); - quit_loop := equal old_dt !dt; - if is_bot !dt then dt := bot_of ik; quit_loop := true; - if M.tracing then M.trace "cong-refine-loop" "old: %a, new: %a" pretty old_dt pretty !dt; - done; - | _ -> () - ); !dt - - - (* map with overflow check *) - let mapovc ?(suppress_ovwarn=false) ?(cast=false) ik r (a, b, c, d, e) = - let map f ?no_ov = function Some x -> Some (f ?no_ov x) | _ -> None in - let intv = map (r.f1_ovc (module I2)) b in - let intv_set = map (r.f1_ovc (module I5)) e in - let no_ov = check_ov ~suppress_ovwarn ~cast ik intv intv_set in - let no_ov = no_ov || should_ignore_overflow ik in - refine ik - ( map (fun ?no_ov x -> r.f1_ovc ?no_ov (module I1) x |> fst) a - , BatOption.map fst intv - , map (fun ?no_ov x -> r.f1_ovc ?no_ov (module I3) x |> fst) c - , map (fun ?no_ov x -> r.f1_ovc ?no_ov (module I4) x |> fst) ~no_ov d - , BatOption.map fst intv_set ) - - (* map2 with overflow check *) - let map2ovc ?(cast=false) ik r (xa, xb, xc, xd, xe) (ya, yb, yc, yd, ye) = - let intv = opt_map2 (r.f2_ovc (module I2)) xb yb in - let intv_set = opt_map2 (r.f2_ovc (module I5)) xe ye in - let no_ov = check_ov ~cast ik intv intv_set in - let no_ov = no_ov || should_ignore_overflow ik in - refine ik - ( opt_map2 (fun ?no_ov x y -> r.f2_ovc ?no_ov (module I1) x y |> fst) xa ya - , BatOption.map fst intv - , opt_map2 (fun ?no_ov x y -> r.f2_ovc ?no_ov (module I3) x y |> fst) xc yc - , opt_map2 (fun ?no_ov x y -> r.f2_ovc ?no_ov (module I4) x y |> fst) ~no_ov:no_ov xd yd - , BatOption.map fst intv_set ) - - let map ik r (a, b, c, d, e) = - refine ik - BatOption. - ( map (r.f1 (module I1)) a - , map (r.f1 (module I2)) b - , map (r.f1 (module I3)) c - , map (r.f1 (module I4)) d - , map (r.f1 (module I5)) e) - - let map2 ?(norefine=false) ik r (xa, xb, xc, xd, xe) (ya, yb, yc, yd, ye) = - let r = - ( opt_map2 (r.f2 (module I1)) xa ya - , opt_map2 (r.f2 (module I2)) xb yb - , opt_map2 (r.f2 (module I3)) xc yc - , opt_map2 (r.f2 (module I4)) xd yd - , opt_map2 (r.f2 (module I5)) xe ye) - in - if norefine then r else refine ik r - - - (* f1: unary ops *) - let neg ?no_ov ik = - mapovc ik {f1_ovc = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.neg ?no_ov ik)} - - let lognot ik = - map ik {f1 = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.lognot ik)} - - let c_lognot ik = - map ik {f1 = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.c_lognot ik)} - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov t = - mapovc ~suppress_ovwarn ~cast:true t {f1_ovc = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.cast_to ?torg ?no_ov t)} - - (* fp: projections *) - let equal_to i x = - let xs = mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.equal_to i } x |> Tuple5.enum |> List.of_enum |> List.filter_map identity in - if List.mem `Eq xs then `Eq else - if List.mem `Neq xs then `Neq else - `Top - - let to_bool = same string_of_bool % mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.to_bool } - let minimal = flat (List.max ~cmp:Z.compare) % mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.minimal } - let maximal = flat (List.min ~cmp:Z.compare) % mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.maximal } - (* others *) - let show x = - match to_int x with - | Some v when not (GobConfig.get_bool "dbg.full-output") -> Z.to_string v - | _ -> mapp { fp = fun (type a) (module I:SOverflow with type t = a) x -> I.name () ^ ":" ^ (I.show x) } x - |> to_list - |> String.concat "; " - let to_yojson = [%to_yojson: Yojson.Safe.t list] % to_list % mapp { fp = fun (type a) (module I:SOverflow with type t = a) x -> I.to_yojson x } - - (* `map/opt_map` are used by `project` *) - let opt_map b f = - curry @@ function None, true -> f | x, y when y || b -> x | _ -> None - let map ~keep r (i1, i2, i3, i4, i5) (b1, b2, b3, b4, b5) = - ( opt_map keep (r.f3 (module I1)) i1 b1 - , opt_map keep (r.f3 (module I2)) i2 b2 - , opt_map keep (r.f3 (module I3)) i3 b3 - , opt_map keep (r.f3 (module I4)) i4 b4 - , opt_map keep (r.f3 (module I5)) i5 b5 ) - - (** Project tuple t to precision p - * We have to deactivate IntDomains after the refinement, since we might - * lose information if we do it before. E.g. only "Interval" is active - * and shall be projected to only "Def_Exc". By seting "Interval" to None - * before refinement we have no information for "Def_Exc". - * - * Thus we have 3 Steps: - * 1. Add padding to t by setting `None` to `I.top_of ik` if p is true for this element - * 2. Refine the padded t - * 3. Set elements of t to `None` if p is false for this element - * - * Side Note: - * ~keep is used to reuse `map/opt_map` for Step 1 and 3. - * ~keep:true will keep elements that are `Some x` but should be set to `None` by p. - * This way we won't loose any information for the refinement. - * ~keep:false will set the elements to `None` as defined by p *) - let project ik (p: int_precision) t = - let t_padded = map ~keep:true { f3 = fun (type a) (module I:SOverflow with type t = a) -> Some (I.top_of ik) } t p in - let t_refined = refine ik t_padded in - map ~keep:false { f3 = fun (type a) (module I:SOverflow with type t = a) -> None } t_refined p - - - (* f2: binary ops *) - let join ik = - map2 ~norefine:true ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.join ik)} - - let meet ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.meet ik)} - - let widen ik = - map2 ~norefine:true ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.widen ik)} - - let narrow ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.narrow ik)} - - let add ?no_ov ik = - map2ovc ik - {f2_ovc = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.add ?no_ov ik)} - - let sub ?no_ov ik = - map2ovc ik - {f2_ovc = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.sub ?no_ov ik)} - - let mul ?no_ov ik = - map2ovc ik - {f2_ovc = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.mul ?no_ov ik)} - - let div ?no_ov ik = - map2ovc ik - {f2_ovc = (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.div ?no_ov ik)} - - let rem ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.rem ik)} - - let lt ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.lt ik)} - - let gt ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.gt ik)} - - let le ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.le ik)} - - let ge ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.ge ik)} - - let eq ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.eq ik)} - - let ne ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.ne ik)} - - let logand ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.logand ik)} - - let logor ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.logor ik)} - - let logxor ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.logxor ik)} - - let shift_left ik = - map2ovc ik {f2_ovc= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.shift_left ik)} - - let shift_right ik = - map2ovc ik {f2_ovc= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.shift_right ik)} - - let c_logand ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.c_logand ik)} - - let c_logor ik = - map2 ik {f2= (fun (type a) (module I : SOverflow with type t = a) ?no_ov -> I.c_logor ik)} - - - (* printing boilerplate *) - let pretty_diff () (x,y) = dprintf "%a instead of %a" pretty x pretty y - let printXml f x = - match to_int x with - | Some v when not (GobConfig.get_bool "dbg.full-output") -> BatPrintf.fprintf f "\n\n%s\n\n\n" (Z.to_string v) - | _ -> BatPrintf.fprintf f "\n\n%s\n\n\n" (show x) - - let invariant_ikind e ik ((_, _, _, x_cong, x_intset) as x) = - (* TODO: do refinement before to ensure incl_list being more precise than intervals, etc (https://github.com/goblint/analyzer/pull/1517#discussion_r1693998515), requires refine functions to actually refine that *) - let simplify_int fallback = - match to_int x with - | Some v -> - (* If definite, output single equality instead of every subdomain repeating same equality (or something less precise). *) - IntInvariant.of_int e ik v - | None -> - fallback () - in - let simplify_all () = - match to_incl_list x with - | Some ps -> - (* If inclusion set, output disjunction of equalities because it subsumes interval(s), exclusion set and congruence. *) - IntInvariant.of_incl_list e ik ps - | None -> - (* Get interval bounds from all domains (intervals and exclusion set ranges). *) - let min = minimal x in - let max = maximal x in - let ns = Option.map fst (to_excl_list x) |? [] in (* Ignore exclusion set bit range, known via interval bounds already. *) - (* "Refine" out-of-bounds exclusions for simpler output. *) - let ns = Option.map_default (fun min -> List.filter (Z.leq min) ns) ns min in - let ns = Option.map_default (fun max -> List.filter (Z.geq max) ns) ns max in - Invariant.( - IntInvariant.of_interval_opt e ik (min, max) && (* Output best interval bounds once instead of multiple subdomains repeating them (or less precise ones). *) - IntInvariant.of_excl_list e ik ns && - Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && (* Output congruence as is. *) - Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset (* Output interval sets as is. *) - ) - in - let simplify_none () = - let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) in - List.fold_left (fun a i -> - Invariant.(a && i) - ) (Invariant.top ()) is - in - match GobConfig.get_string "ana.base.invariant.int.simplify" with - | "none" -> simplify_none () - | "int" -> simplify_int simplify_none - | "all" -> simplify_int simplify_all - | _ -> assert false - - let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) - - let relift (a, b, c, d, e) = - (Option.map I1.relift a, Option.map I2.relift b, Option.map I3.relift c, Option.map I4.relift d, Option.map I5.relift e) -end - -module IntDomTuple = -struct - module I = IntDomLifter (IntDomTupleImpl) - include I - - let top () = failwith "top in IntDomTuple not supported. Use top_of instead." - let no_interval (x: I.t) = {x with v = IntDomTupleImpl.no_interval x.v} - - let no_intervalSet (x: I.t) = {x with v = IntDomTupleImpl.no_intervalSet x.v} -end - -let of_const (i, ik, str) = IntDomTuple.of_int ik i From 8c563ae9c3af6b1d0b4ceb2fdffbc9b1e7e94cd1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:54:49 +0300 Subject: [PATCH 102/157] Rename IntDomain0 -> CongruenceDomain for split --- .../value/cdomains/{intDomain0.ml => int/congruenceDomain.ml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/cdomain/value/cdomains/{intDomain0.ml => int/congruenceDomain.ml} (100%) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/int/congruenceDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/intDomain0.ml rename to src/cdomain/value/cdomains/int/congruenceDomain.ml From d66919e5b7ffb07fde6ae1929ca0c8d486f2acba Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:55:25 +0300 Subject: [PATCH 103/157] Remove non-CongruenceDomain parts --- .../value/cdomains/int/congruenceDomain.ml | 2776 +---------------- 1 file changed, 1 insertion(+), 2775 deletions(-) diff --git a/src/cdomain/value/cdomains/int/congruenceDomain.ml b/src/cdomain/value/cdomains/int/congruenceDomain.ml index 7450e8a212..a88ffbc813 100644 --- a/src/cdomain/value/cdomains/int/congruenceDomain.ml +++ b/src/cdomain/value/cdomains/int/congruenceDomain.ml @@ -1,2747 +1,5 @@ -open GobConfig -open GoblintCil -open Pretty -open PrecisionUtil - -module M = Messages - -let (%) = Batteries.(%) -let (|?) = Batteries.(|?) - -exception IncompatibleIKinds of string -exception Unknown -exception Error -exception ArithmeticOnIntegerBot of string - - - - -(** Define records that hold mutable variables representing different Configuration values. - * These values are used to keep track of whether or not the corresponding Config values are en-/disabled *) -type ana_int_config_values = { - mutable interval_threshold_widening : bool option; - mutable interval_narrow_by_meet : bool option; - mutable def_exc_widen_by_join : bool option; - mutable interval_threshold_widening_constants : string option; - mutable refinement : string option; -} - -let ana_int_config: ana_int_config_values = { - interval_threshold_widening = None; - interval_narrow_by_meet = None; - def_exc_widen_by_join = None; - interval_threshold_widening_constants = None; - refinement = None; -} - -let get_interval_threshold_widening () = - if ana_int_config.interval_threshold_widening = None then - ana_int_config.interval_threshold_widening <- Some (get_bool "ana.int.interval_threshold_widening"); - Option.get ana_int_config.interval_threshold_widening - -let get_interval_narrow_by_meet () = - if ana_int_config.interval_narrow_by_meet = None then - ana_int_config.interval_narrow_by_meet <- Some (get_bool "ana.int.interval_narrow_by_meet"); - Option.get ana_int_config.interval_narrow_by_meet - -let get_def_exc_widen_by_join () = - if ana_int_config.def_exc_widen_by_join = None then - ana_int_config.def_exc_widen_by_join <- Some (get_bool "ana.int.def_exc_widen_by_join"); - Option.get ana_int_config.def_exc_widen_by_join - -let get_interval_threshold_widening_constants () = - if ana_int_config.interval_threshold_widening_constants = None then - ana_int_config.interval_threshold_widening_constants <- Some (get_string "ana.int.interval_threshold_widening_constants"); - Option.get ana_int_config.interval_threshold_widening_constants - -let get_refinement () = - if ana_int_config.refinement = None then - ana_int_config.refinement <- Some (get_string "ana.int.refinement"); - Option.get ana_int_config.refinement - - - -(** Whether for a given ikind, we should compute with wrap-around arithmetic. - * Always for unsigned types, for signed types if 'sem.int.signed_overflow' is 'assume_wraparound' *) -let should_wrap ik = not (Cil.isSigned ik) || get_string "sem.int.signed_overflow" = "assume_wraparound" - -(** Whether for a given ikind, we should assume there are no overflows. - * Always false for unsigned types, true for signed types if 'sem.int.signed_overflow' is 'assume_none' *) -let should_ignore_overflow ik = Cil.isSigned ik && get_string "sem.int.signed_overflow" = "assume_none" - -let widening_thresholds = ResettableLazy.from_fun WideningThresholds.thresholds -let widening_thresholds_desc = ResettableLazy.from_fun (List.rev % WideningThresholds.thresholds) - -type overflow_info = { overflow: bool; underflow: bool;} - -let set_overflow_flag ~cast ~underflow ~overflow ik = - if !AnalysisState.executing_speculative_computations then - (* Do not produce warnings when the operations are not actually happening in code *) - () - else - let signed = Cil.isSigned ik in - if !AnalysisState.postsolving && signed && not cast then - AnalysisState.svcomp_may_overflow := true; - let sign = if signed then "Signed" else "Unsigned" in - match underflow, overflow with - | true, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190; CWE 191] "%s integer overflow and underflow" sign - | true, false -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 191] "%s integer underflow" sign - | false, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190] "%s integer overflow" sign - | false, false -> assert false - -let reset_lazy () = - ResettableLazy.reset widening_thresholds; - ResettableLazy.reset widening_thresholds_desc; - ana_int_config.interval_threshold_widening <- None; - ana_int_config.interval_narrow_by_meet <- None; - ana_int_config.def_exc_widen_by_join <- None; - ana_int_config.interval_threshold_widening_constants <- None; - ana_int_config.refinement <- None - -module type Arith = -sig - type t - val neg: t -> t - val add: t -> t -> t - val sub: t -> t -> t - val mul: t -> t -> t - val div: t -> t -> t - val rem: t -> t -> t - - val lt: t -> t -> t - val gt: t -> t -> t - val le: t -> t -> t - val ge: t -> t -> t - val eq: t -> t -> t - val ne: t -> t -> t - - val lognot: t -> t - val logand: t -> t -> t - val logor : t -> t -> t - val logxor: t -> t -> t - - val shift_left : t -> t -> t - val shift_right: t -> t -> t - - val c_lognot: t -> t - val c_logand: t -> t -> t - val c_logor : t -> t -> t +open IntDomain0 -end - -module type ArithIkind = -sig - type t - val neg: Cil.ikind -> t -> t - val add: Cil.ikind -> t -> t -> t - val sub: Cil.ikind -> t -> t -> t - val mul: Cil.ikind -> t -> t -> t - val div: Cil.ikind -> t -> t -> t - val rem: Cil.ikind -> t -> t -> t - - val lt: Cil.ikind -> t -> t -> t - val gt: Cil.ikind -> t -> t -> t - val le: Cil.ikind -> t -> t -> t - val ge: Cil.ikind -> t -> t -> t - val eq: Cil.ikind -> t -> t -> t - val ne: Cil.ikind -> t -> t -> t - - val lognot: Cil.ikind -> t -> t - val logand: Cil.ikind -> t -> t -> t - val logor : Cil.ikind -> t -> t -> t - val logxor: Cil.ikind -> t -> t -> t - - val shift_left : Cil.ikind -> t -> t -> t - val shift_right: Cil.ikind -> t -> t -> t - - val c_lognot: Cil.ikind -> t -> t - val c_logand: Cil.ikind -> t -> t -> t - val c_logor : Cil.ikind -> t -> t -> t - -end - -(* Shared functions between S and Z *) -module type B = -sig - include Lattice.S - type int_t - val bot_of: Cil.ikind -> t - val top_of: Cil.ikind -> t - val to_int: t -> int_t option - val equal_to: int_t -> t -> [`Eq | `Neq | `Top] - - val to_bool: t -> bool option - val to_excl_list: t -> (int_t list * (int64 * int64)) option - val of_excl_list: Cil.ikind -> int_t list -> t - val is_excl_list: t -> bool - - val to_incl_list: t -> int_t list option - - val maximal : t -> int_t option - val minimal : t -> int_t option - - val cast_to: ?suppress_ovwarn:bool -> ?torg:Cil.typ -> Cil.ikind -> t -> t -end - -(** Interface of IntDomain implementations that do not take ikinds for arithmetic operations yet. TODO: Should be ported to S in the future. *) -module type IkindUnawareS = -sig - include B - include Arith with type t := t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: int_t -> t - val of_bool: bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val arbitrary: unit -> t QCheck.arbitrary - val invariant: Cil.exp -> t -> Invariant.t -end - -(** Interface of IntDomain implementations taking an ikind for arithmetic operations *) -module type S = -sig - include B - include ArithIkind with type t:= t - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val neg : ?no_ov:bool -> Cil.ikind -> t -> t - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t - - val join: Cil.ikind -> t -> t -> t - val meet: Cil.ikind -> t -> t -> t - val narrow: Cil.ikind -> t -> t -> t - val widen: Cil.ikind -> t -> t -> t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val is_top_of: Cil.ikind -> t -> bool - val invariant_ikind : Cil.exp -> Cil.ikind -> t -> Invariant.t - - val refine_with_congruence: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_interval: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_excl_list: Cil.ikind -> t -> (int_t list * (int64 * int64)) option -> t - val refine_with_incl_list: Cil.ikind -> t -> int_t list option -> t - - val project: Cil.ikind -> int_precision -> t -> t - val arbitrary: Cil.ikind -> t QCheck.arbitrary -end - -module type SOverflow = -sig - - include S - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val neg : ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val of_int : Cil.ikind -> int_t -> t * overflow_info - - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t * overflow_info - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - - val shift_left : Cil.ikind -> t -> t -> t * overflow_info - - val shift_right : Cil.ikind -> t -> t -> t * overflow_info -end - -module type Y = -sig - (* include B *) - include B - include Arith with type t:= t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val is_top_of: Cil.ikind -> t -> bool - - val project: int_precision -> t -> t - val invariant: Cil.exp -> t -> Invariant.t -end - -module type Z = Y with type int_t = Z.t - - -module IntDomLifter (I : S) = -struct - open Cil - type int_t = I.int_t - type t = { v : I.t; ikind : CilType.Ikind.t } [@@deriving eq, ord, hash] - - let ikind {ikind; _} = ikind - - (* Helper functions *) - let check_ikinds x y = if x.ikind <> y.ikind then raise (IncompatibleIKinds (GobPretty.sprintf "ikinds %a and %a are incompatible. Values: %a and %a" CilType.Ikind.pretty x.ikind CilType.Ikind.pretty y.ikind I.pretty x.v I.pretty y.v)) - let lift op x = {x with v = op x.ikind x.v } - (* For logical operations the result is of type int *) - let lift_logical op x = {v = op x.ikind x.v; ikind = Cil.IInt} - let lift2 op x y = check_ikinds x y; {x with v = op x.ikind x.v y.v } - let lift2_cmp op x y = check_ikinds x y; {v = op x.ikind x.v y.v; ikind = Cil.IInt} - - let bot_of ikind = { v = I.bot_of ikind; ikind} - let bot () = failwith "bot () is not implemented for IntDomLifter." - let is_bot x = I.is_bot x.v - let top_of ikind = { v = I.top_of ikind; ikind} - let top () = failwith "top () is not implemented for IntDomLifter." - let is_top x = I.is_top x.v - - (* Leq does not check for ikind, because it is used in invariant with arguments of different type. - TODO: check ikinds here and fix invariant to work with right ikinds *) - let leq x y = I.leq x.v y.v - let join = lift2 I.join - let meet = lift2 I.meet - let widen = lift2 I.widen - let narrow = lift2 I.narrow - - let show x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - "⊤" - else - I.show x.v (* TODO add ikind to output *) - let pretty () x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - Pretty.text "⊤" - else - I.pretty () x.v (* TODO add ikind to output *) - let pretty_diff () (x, y) = I.pretty_diff () (x.v, y.v) (* TODO check ikinds, add them to output *) - let printXml o x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - BatPrintf.fprintf o "\n\n⊤\n\n\n" - else - I.printXml o x.v (* TODO add ikind to output *) - (* This is for debugging *) - let name () = "IntDomLifter(" ^ (I.name ()) ^ ")" - let to_yojson x = I.to_yojson x.v - let invariant e x = - let e' = Cilfacade.mkCast ~e ~newt:(TInt (x.ikind, [])) in - I.invariant_ikind e' x.ikind x.v - let tag x = I.tag x.v - let arbitrary ik = failwith @@ "Arbitrary not implement for " ^ (name ()) ^ "." - let to_int x = I.to_int x.v - let of_int ikind x = { v = I.of_int ikind x; ikind} - let equal_to i x = I.equal_to i x.v - let to_bool x = I.to_bool x.v - let of_bool ikind b = { v = I.of_bool ikind b; ikind} - let to_excl_list x = I.to_excl_list x.v - let of_excl_list ikind is = {v = I.of_excl_list ikind is; ikind} - let is_excl_list x = I.is_excl_list x.v - let to_incl_list x = I.to_incl_list x.v - let of_interval ?(suppress_ovwarn=false) ikind (lb,ub) = {v = I.of_interval ~suppress_ovwarn ikind (lb,ub); ikind} - let of_congruence ikind (c,m) = {v = I.of_congruence ikind (c,m); ikind} - let starting ?(suppress_ovwarn=false) ikind i = {v = I.starting ~suppress_ovwarn ikind i; ikind} - let ending ?(suppress_ovwarn=false) ikind i = {v = I.ending ~suppress_ovwarn ikind i; ikind} - let maximal x = I.maximal x.v - let minimal x = I.minimal x.v - - let neg = lift I.neg - let add = lift2 I.add - let sub = lift2 I.sub - let mul = lift2 I.mul - let div = lift2 I.div - let rem = lift2 I.rem - let lt = lift2_cmp I.lt - let gt = lift2_cmp I.gt - let le = lift2_cmp I.le - let ge = lift2_cmp I.ge - let eq = lift2_cmp I.eq - let ne = lift2_cmp I.ne - let lognot = lift I.lognot - let logand = lift2 I.logand - let logor = lift2 I.logor - let logxor = lift2 I.logxor - let shift_left x y = {x with v = I.shift_left x.ikind x.v y.v } (* TODO check ikinds*) - let shift_right x y = {x with v = I.shift_right x.ikind x.v y.v } (* TODO check ikinds*) - let c_lognot = lift_logical I.c_lognot - let c_logand = lift2 I.c_logand - let c_logor = lift2 I.c_logor - - let cast_to ?(suppress_ovwarn=false) ?torg ikind x = {v = I.cast_to ~suppress_ovwarn ~torg:(TInt(x.ikind,[])) ikind x.v; ikind} - - let is_top_of ik x = ik = x.ikind && I.is_top_of ik x.v - - let relift x = { v = I.relift x.v; ikind = x.ikind } - - let project p v = { v = I.project v.ikind p v.v; ikind = v.ikind } -end - -module type Ikind = -sig - val ikind: unit -> Cil.ikind -end - -module PtrDiffIkind : Ikind = -struct - let ikind = Cilfacade.ptrdiff_ikind -end - -module IntDomWithDefaultIkind (I: Y) (Ik: Ikind) : Y with type t = I.t and type int_t = I.int_t = -struct - include I - let top () = I.top_of (Ik.ikind ()) - let bot () = I.bot_of (Ik.ikind ()) -end - -module Size = struct (* size in bits as int, range as int64 *) - open Cil - let sign x = if Z.compare x Z.zero < 0 then `Signed else `Unsigned - - let top_typ = TInt (ILongLong, []) - let min_for x = intKindForValue x (sign x = `Unsigned) - let bit = function (* bits needed for representation *) - | IBool -> 1 - | ik -> bytesSizeOfInt ik * 8 - let is_int64_big_int x = Z.fits_int64 x - let card ik = (* cardinality *) - let b = bit ik in - Z.shift_left Z.one b - let bits ik = (* highest bits for neg/pos values *) - let s = bit ik in - if isSigned ik then s-1, s-1 else 0, s - let bits_i64 ik = BatTuple.Tuple2.mapn Int64.of_int (bits ik) - let range ik = - let a,b = bits ik in - let x = if isSigned ik then Z.neg (Z.shift_left Z.one a) (* -2^a *) else Z.zero in - let y = Z.pred (Z.shift_left Z.one b) in (* 2^b - 1 *) - x,y - - let is_cast_injective ~from_type ~to_type = - let (from_min, from_max) = range (Cilfacade.get_ikind from_type) in - let (to_min, to_max) = range (Cilfacade.get_ikind to_type) in - if M.tracing then M.trace "int" "is_cast_injective %a (%a, %a) -> %a (%a, %a)" CilType.Typ.pretty from_type GobZ.pretty from_min GobZ.pretty from_max CilType.Typ.pretty to_type GobZ.pretty to_min GobZ.pretty to_max; - Z.compare to_min from_min <= 0 && Z.compare from_max to_max <= 0 - - let cast t x = (* TODO: overflow is implementation-dependent! *) - if t = IBool then - (* C11 6.3.1.2 Boolean type *) - if Z.equal x Z.zero then Z.zero else Z.one - else - let a,b = range t in - let c = card t in - let y = Z.erem x c in - let y = if Z.gt y b then Z.sub y c - else if Z.lt y a then Z.add y c - else y - in - if M.tracing then M.tracel "cast" "Cast %a to range [%a, %a] (%a) = %a (%s in int64)" GobZ.pretty x GobZ.pretty a GobZ.pretty b GobZ.pretty c GobZ.pretty y (if is_int64_big_int y then "fits" else "does not fit"); - y - - let min_range_sign_agnostic x = - let size ik = - let a,b = bits_i64 ik in - Int64.neg a,b - in - if sign x = `Signed then - size (min_for x) - else - let a, b = size (min_for x) in - if b <= 64L then - let upper_bound_less = Int64.sub b 1L in - let max_one_less = Z.(pred @@ shift_left Z.one (Int64.to_int upper_bound_less)) in - if x <= max_one_less then - a, upper_bound_less - else - a,b - else - a, b - - (* From the number of bits used to represent a positive value, determines the maximal representable value *) - let max_from_bit_range pos_bits = Z.(pred @@ shift_left Z.one (to_int (Z.of_int64 pos_bits))) - - (* From the number of bits used to represent a non-positive value, determines the minimal representable value *) - let min_from_bit_range neg_bits = Z.(if neg_bits = 0L then Z.zero else neg @@ shift_left Z.one (to_int (neg (Z.of_int64 neg_bits)))) - -end - - -module StdTop (B: sig type t val top_of: Cil.ikind -> t end) = struct - open B - (* these should be overwritten for better precision if possible: *) - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ik x = top_of ik - let ending ?(suppress_ovwarn=false) ik x = top_of ik - let maximal x = None - let minimal x = None -end - -module Std (B: sig - type t - val name: unit -> string - val top_of: Cil.ikind -> t - val bot_of: Cil.ikind -> t - val show: t -> string - val equal: t -> t -> bool - end) = struct - include Printable.StdLeaf - let name = B.name (* overwrite the one from Printable.Std *) - open B - let is_top x = failwith "is_top not implemented for IntDomain.Std" - let is_bot x = B.equal x (bot_of Cil.IInt) (* Here we assume that the representation of bottom is independent of the ikind - This may be true for intdomain implementations, but not e.g. for IntDomLifter. *) - let is_top_of ik x = B.equal x (top_of ik) - - (* all output is based on B.show *) - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - let pretty_diff () (x,y) = dprintf "%s: %a instead of %a" (name ()) pretty x pretty y - - include StdTop (B) -end - -(* Textbook interval arithmetic, without any overflow handling etc. *) -module IntervalArith (Ints_t : IntOps.IntOps) = struct - let min4 a b c d = Ints_t.min (Ints_t.min a b) (Ints_t.min c d) - let max4 a b c d = Ints_t.max (Ints_t.max a b) (Ints_t.max c d) - - let mul (x1, x2) (y1, y2) = - let x1y1 = (Ints_t.mul x1 y1) in - let x1y2 = (Ints_t.mul x1 y2) in - let x2y1 = (Ints_t.mul x2 y1) in - let x2y2 = (Ints_t.mul x2 y2) in - (min4 x1y1 x1y2 x2y1 x2y2, max4 x1y1 x1y2 x2y1 x2y2) - - let shift_left (x1,x2) (y1,y2) = - let y1p = Ints_t.shift_left Ints_t.one y1 in - let y2p = Ints_t.shift_left Ints_t.one y2 in - mul (x1, x2) (y1p, y2p) - - let div (x1, x2) (y1, y2) = - let x1y1n = (Ints_t.div x1 y1) in - let x1y2n = (Ints_t.div x1 y2) in - let x2y1n = (Ints_t.div x2 y1) in - let x2y2n = (Ints_t.div x2 y2) in - let x1y1p = (Ints_t.div x1 y1) in - let x1y2p = (Ints_t.div x1 y2) in - let x2y1p = (Ints_t.div x2 y1) in - let x2y2p = (Ints_t.div x2 y2) in - (min4 x1y1n x1y2n x2y1n x2y2n, max4 x1y1p x1y2p x2y1p x2y2p) - - let add (x1, x2) (y1, y2) = (Ints_t.add x1 y1, Ints_t.add x2 y2) - let sub (x1, x2) (y1, y2) = (Ints_t.sub x1 y2, Ints_t.sub x2 y1) - - let neg (x1, x2) = (Ints_t.neg x2, Ints_t.neg x1) - - let one = (Ints_t.one, Ints_t.one) - let zero = (Ints_t.zero, Ints_t.zero) - let top_bool = (Ints_t.zero, Ints_t.one) - - let to_int (x1, x2) = - if Ints_t.equal x1 x2 then Some x1 else None - - let upper_threshold u max_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - let max_ik' = Ints_t.to_bigint max_ik in - let t = List.find_opt (fun x -> Z.compare u x <= 0 && Z.compare x max_ik' <= 0) ts in - BatOption.map_default Ints_t.of_bigint max_ik t - let lower_threshold l min_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - let min_ik' = Ints_t.to_bigint min_ik in - let t = List.find_opt (fun x -> Z.compare l x >= 0 && Z.compare x min_ik' >= 0) ts in - BatOption.map_default Ints_t.of_bigint min_ik t - let is_upper_threshold u = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - List.exists (Z.equal u) ts - let is_lower_threshold l = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - List.exists (Z.equal l) ts -end - -module IntInvariant = -struct - let of_int e ik x = - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.none - - let of_incl_list e ik ps = - match ps with - | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> - assert (List.mem Z.zero ps); - assert (List.mem Z.one ps); - Invariant.none - | [_] when get_bool "witness.invariant.exact" -> - Invariant.none - | _ :: _ :: _ - | [_] | [] -> - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ps - - let of_interval_opt e ik = function - | (Some x1, Some x2) when Z.equal x1 x2 -> - of_int e ik x1 - | x1_opt, x2_opt -> - let (min_ik, max_ik) = Size.range ik in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = - match x1_opt, inexact_type_bounds with - | Some x1, false when Z.equal min_ik x1 -> Invariant.none - | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) - | None, _ -> Invariant.none - in - let i2 = - match x2_opt, inexact_type_bounds with - | Some x2, false when Z.equal x2 max_ik -> Invariant.none - | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) - | None, _ -> Invariant.none - in - Invariant.(i1 && i2) - - let of_interval e ik (x1, x2) = - of_interval_opt e ik (Some x1, Some x2) - - let of_excl_list e ik ns = - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) (Invariant.top ()) ns -end - -module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = -struct - let name () = "intervals" - type int_t = Ints_t.t - type t = (Ints_t.t * Ints_t.t) option [@@deriving eq, ord, hash] - module IArith = IntervalArith (Ints_t) - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - let top_of ik = Some (range ik) - let bot () = None - let bot_of ik = bot () (* TODO: improve *) - - let show = function None -> "bottom" | Some (x,y) -> "["^Ints_t.to_string x^","^Ints_t.to_string y^"]" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) -> - if a = b && b = i then `Eq else if Ints_t.compare a i <= 0 && Ints_t.compare i b <=0 then `Top else `Neq - - let norm ?(suppress_ovwarn=false) ?(cast=false) ik : (t -> t * overflow_info) = function None -> (None, {underflow=false; overflow=false}) | Some (x,y) -> - if Ints_t.compare x y > 0 then - (None,{underflow=false; overflow=false}) - else ( - let (min_ik, max_ik) = range ik in - let underflow = Ints_t.compare min_ik x > 0 in - let overflow = Ints_t.compare max_ik y < 0 in - let ov_info = { underflow = underflow && not suppress_ovwarn; overflow = overflow && not suppress_ovwarn } in - let v = - if underflow || overflow then - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (Ints_t.sub max_ik min_ik) in - let resdiff = Ints_t.abs (Ints_t.sub y x) in - if Ints_t.compare resdiff diff > 0 then - top_of ik - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if Ints_t.compare l u <= 0 then - Some (l, u) - else - (* Interval that wraps around (begins to the right of its end). We can not represent such intervals *) - top_of ik - else if not cast && should_ignore_overflow ik then - let tl, tu = BatOption.get @@ top_of ik in - Some (Ints_t.max tl x, Ints_t.min tu y) - else - top_of ik - else - Some (x,y) - in - (v, ov_info) - ) - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (x1,x2), Some (y1,y2) -> Ints_t.compare x1 y1 >= 0 && Ints_t.compare x2 y2 <= 0 - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.min x1 y1, Ints_t.max x2 y2) |> fst - - let meet ik (x:t) y = - match x, y with - | None, z | z, None -> None - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.max x1 y1, Ints_t.min x2 y2) |> fst - - (* TODO: change to_int signature so it returns a big_int *) - let to_int x = Option.bind x (IArith.to_int) - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm ~suppress_ovwarn ik @@ Some (x,y) - let of_int ik (x: int_t) = of_interval ik (x,x) - let zero = Some IArith.zero - let one = Some IArith.one - let top_bool = Some IArith.top_bool - - let of_bool _ik = function true -> one | false -> zero - let to_bool (a: t) = match a with - | None -> None - | Some (l, u) when Ints_t.compare l Ints_t.zero = 0 && Ints_t.compare u Ints_t.zero = 0 -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (fst (range ik), n) - - (* TODO: change signature of maximal, minimal to return big_int*) - let maximal = function None -> None | Some (x,y) -> Some y - let minimal = function None -> None | Some (x,y) -> Some x - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov t = norm ~cast:true t (* norm does all overflow handling *) - - let widen ik x y = - match x, y with - | None, z | z, None -> z - | Some (l0,u0), Some (l1,u1) -> - let (min_ik, max_ik) = range ik in - let threshold = get_interval_threshold_widening () in - let l2 = - if Ints_t.compare l0 l1 = 0 then l0 - else if threshold then IArith.lower_threshold l1 min_ik - else min_ik - in - let u2 = - if Ints_t.compare u0 u1 = 0 then u0 - else if threshold then IArith.upper_threshold u1 max_ik - else max_ik - in - norm ik @@ Some (l2,u2) |> fst - let widen ik x y = - let r = widen ik x y in - if M.tracing && not (equal x y) then M.tracel "int" "interval widen %a %a -> %a" pretty x pretty y pretty r; - assert (leq x y); (* TODO: remove for performance reasons? *) - r - - let narrow ik x y = - match x, y with - | _,None | None, _ -> None - | Some (x1,x2), Some (y1,y2) -> - let threshold = get_interval_threshold_widening () in - let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 || threshold && Ints_t.compare y1 x1 > 0 && IArith.is_lower_threshold x1 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 || threshold && Ints_t.compare y2 x2 < 0 && IArith.is_upper_threshold x2 then y2 else x2 in - norm ik @@ Some (lr,ur) |> fst - - - let narrow ik x y = - if get_interval_narrow_by_meet () then - meet ik x y - else - narrow ik x y - - let log f ~annihilator ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, _ when x = annihilator -> of_bool ik annihilator - | _, Some y when y = annihilator -> of_bool ik annihilator - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) ~annihilator:true - let c_logand = log (&&) ~annihilator:false - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let bit f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - let bitcomp f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{underflow=false; overflow=false})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let logxor = bit (fun _ik -> Ints_t.logxor) - - let logand ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (Ints_t.logand x y) |> fst with Division_by_zero -> top_of ik) - | _, Some y when Ints_t.equal y Ints_t.zero -> of_int ik Ints_t.zero |> fst - | _, Some y when Ints_t.equal y Ints_t.one -> of_interval ik (Ints_t.zero, Ints_t.one) |> fst - | _ -> top_of ik - - let logor = bit (fun _ik -> Ints_t.logor) - - let bit1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_int i1 with - | Some x -> of_int ik (f ik x) |> fst - | _ -> top_of ik - - let lognot = bit1 (fun _ik -> Ints_t.lognot) - let shift_right = bitcomp (fun _ik x y -> Ints_t.shift_right x (Ints_t.to_int y)) - - let neg ?no_ov ik = function None -> (None,{underflow=false; overflow=false}) | Some x -> norm ik @@ Some (IArith.neg x) - - let binary_op_with_norm ?no_ov op ik x y = match x, y with - | None, None -> (None, {overflow=false; underflow= false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some x, Some y -> norm ik @@ Some (op x y) - - let add ?no_ov = binary_op_with_norm IArith.add - let mul ?no_ov = binary_op_with_norm IArith.mul - let sub ?no_ov = binary_op_with_norm IArith.sub - - let shift_left ik a b = - match is_bot a, is_bot b with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show a) (show b))) - | _ -> - match a, minimal b, maximal b with - | Some a, Some bl, Some bu when (Ints_t.compare bl Ints_t.zero >= 0) -> - (try - let r = IArith.shift_left a (Ints_t.to_int bl, Ints_t.to_int bu) in - norm ik @@ Some r - with Z.Overflow -> (top_of ik,{underflow=false; overflow=true})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let rem ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (xl, xu), Some (yl, yu) -> - if is_top_of ik x && is_top_of ik y then - (* This is needed to preserve soundness also on things bigger than int32 e.g. *) - (* x: 3803957176L -> T in Interval32 *) - (* y: 4209861404L -> T in Interval32 *) - (* x % y: 3803957176L -> T in Interval32 *) - (* T in Interval32 is [-2147483648,2147483647] *) - (* the code below computes [-2147483647,2147483647] for this though which is unsound *) - top_of ik - else - (* If we have definite values, Ints_t.rem will give a definite result. - * Otherwise we meet with a [range] the result can be in. - * This range is [0, min xu b] if x is positive, and [max xl -b, min xu b] if x can be negative. - * The precise bound b is one smaller than the maximum bound. Negative y give the same result as positive. *) - let pos x = if Ints_t.compare x Ints_t.zero < 0 then Ints_t.neg x else x in - let b = Ints_t.sub (Ints_t.max (pos yl) (pos yu)) Ints_t.one in - let range = if Ints_t.compare xl Ints_t.zero>= 0 then Some (Ints_t.zero, Ints_t.min xu b) else Some (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit (fun _ik -> Ints_t.rem) ik x y) range - - let rec div ?no_ov ik x y = - match x, y with - | None, None -> (bot (),{underflow=false; overflow=false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | (Some (x1,x2) as x), (Some (y1,y2) as y) -> - begin - let is_zero v = Ints_t.compare v Ints_t.zero = 0 in - match y1, y2 with - | l, u when is_zero l && is_zero u -> (top_of ik,{underflow=false; overflow=false}) (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> div ik (Some (x1,x2)) (Some (Ints_t.one,y2)) - | _, u when is_zero u -> div ik (Some (x1,x2)) (Some (y1, Ints_t.(neg one))) - | _ when leq (of_int ik (Ints_t.zero) |> fst) (Some (y1,y2)) -> (top_of ik,{underflow=false; overflow=false}) - | _ -> binary_op_with_norm IArith.div ik x y - end - - let ne ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik true - else if Ints_t.compare x2 y1 <= 0 && Ints_t.compare y2 x1 <= 0 then - of_bool ik false - else top_bool - - let eq ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 && Ints_t.compare x2 y1 <= 0 then - of_bool ik true - else if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik false - else top_bool - - let ge ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 then of_bool ik true - else if Ints_t.compare x2 y1 < 0 then of_bool ik false - else top_bool - - let le ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 <= 0 then of_bool ik true - else if Ints_t.compare y2 x1 < 0 then of_bool ik false - else top_bool - - let gt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 then of_bool ik true - else if Ints_t.compare x2 y1 <= 0 then of_bool ik false - else top_bool - - let lt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 < 0 then of_bool ik true - else if Ints_t.compare y2 x1 <= 0 then of_bool ik false - else top_bool - - let invariant_ikind e ik = function - | Some (x1, x2) -> - let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in - IntInvariant.of_interval e ik (x1', x2') - | None -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let shrink = function - | Some (l, u) -> (return None) <+> (GobQCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) - | None -> empty - in - QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) (fun x -> of_interval ik x |> fst ) pair_arb) - - let modulo n k = - let result = Ints_t.rem n k in - if Ints_t.compare result Ints_t.zero >= 0 then result - else Ints_t.add result k - - let refine_with_congruence ik (intv : t) (cong : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if Ints_t.equal m Ints_t.zero && (Ints_t.compare c x < 0 || Ints_t.compare c y > 0) then None - else if Ints_t.equal m Ints_t.zero then - Some (c, c) - else - let (min_ik, max_ik) = range ik in - let rcx = - if Ints_t.equal x min_ik then x else - Ints_t.add x (modulo (Ints_t.sub c x) (Ints_t.abs m)) in - let lcy = - if Ints_t.equal y max_ik then y else - Ints_t.sub y (modulo (Ints_t.sub y c) (Ints_t.abs m)) in - if Ints_t.compare rcx lcy > 0 then None - else if Ints_t.equal rcx lcy then norm ik @@ Some (rcx, rcx) |> fst - else norm ik @@ Some (rcx, lcy) |> fst - | _ -> None - - let refine_with_congruence ik x y = - let refn = refine_with_congruence ik x y in - if M.tracing then M.trace "refine" "int_refine_with_congruence %a %a -> %a" pretty x pretty y pretty refn; - refn - - let refine_with_interval ik a b = meet ik a b - - let refine_with_excl_list ik (intv : t) (excl : (int_t list * (int64 * int64)) option) : t = - match intv, excl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls, (rl, rh)) -> - let rec shrink op b = - let new_b = (op b (Ints_t.of_int(Bool.to_int(BatList.mem_cmp Ints_t.compare b ls)))) in - if not (Ints_t.equal b new_b) then shrink op new_b else new_b - in - let (min_ik, max_ik) = range ik in - let l' = if Ints_t.equal l min_ik then l else shrink Ints_t.add l in - let u' = if Ints_t.equal u max_ik then u else shrink Ints_t.sub u in - let intv' = norm ik @@ Some (l', u') |> fst in - let range = norm ~suppress_ovwarn:true ik (Some (Ints_t.of_bigint (Size.min_from_bit_range rl), Ints_t.of_bigint (Size.max_from_bit_range rh))) |> fst in - meet ik intv' range - - let refine_with_incl_list ik (intv: t) (incl : (int_t list) option) : t = - match intv, incl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls) -> - let rec min m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> min (Some x) xs | Some m -> if Ints_t.compare m x < 0 then min (Some m) xs else min (Some x) xs in - let rec max m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> max (Some x) xs | Some m -> if Ints_t.compare m x > 0 then max (Some m) xs else max (Some x) xs in - match min None ls, max None ls with - | Some m1, Some m2 -> refine_with_interval ik (Some(l, u)) (Some (m1, m2)) - | _, _-> intv - - let project ik p t = t -end - -(** IntervalSetFunctor that is not just disjunctive completion of intervals, but attempts to be precise for wraparound arithmetic for unsigned types *) -module IntervalSetFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) list = -struct - - module Interval = IntervalFunctor (Ints_t) - module IArith = IntervalArith (Ints_t) - - - let name () = "interval_sets" - - type int_t = Ints_t.t - - let (>.) a b = Ints_t.compare a b > 0 - let (=.) a b = Ints_t.compare a b = 0 - let (<.) a b = Ints_t.compare a b < 0 - let (>=.) a b = Ints_t.compare a b >= 0 - let (<=.) a b = Ints_t.compare a b <= 0 - let (+.) a b = Ints_t.add a b - let (-.) a b = Ints_t.sub a b - - (* - Each domain's element is guaranteed to be in canonical form. That is, each interval contained - inside the set does not overlap with each other and they are not adjacent. - *) - type t = (Ints_t.t * Ints_t.t) list [@@deriving eq, hash, ord] - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - - let top_of ik = [range ik] - - let bot () = [] - - let bot_of ik = bot () - - let show (x: t) = - let show_interval i = Printf.sprintf "[%s, %s]" (Ints_t.to_string (fst i)) (Ints_t.to_string (snd i)) in - List.fold_left (fun acc i -> (show_interval i) :: acc) [] x |> List.rev |> String.concat ", " |> Printf.sprintf "[%s]" - - (* New type definition for the sweeping line algorithm used for implementing join/meet functions. *) - type event = Enter of Ints_t.t | Exit of Ints_t.t - - let unbox_event = function Enter x -> x | Exit x -> x - - let cmp_events x y = - (* Deliberately comparing ints first => Cannot be derived *) - let res = Ints_t.compare (unbox_event x) (unbox_event y) in - if res <> 0 then res - else - begin - match (x, y) with - | (Enter _, Exit _) -> -1 - | (Exit _, Enter _) -> 1 - | (_, _) -> 0 - end - - let interval_set_to_events (xs: t) = - List.concat_map (fun (a, b) -> [Enter a; Exit b]) xs - - let two_interval_sets_to_events (xs: t) (ys: t) = - let xs = interval_set_to_events xs in - let ys = interval_set_to_events ys in - List.merge cmp_events xs ys - - (* Using the sweeping line algorithm, combined_event_list returns a new event list representing the intervals in which at least n intervals in xs overlap - This function is used for both join and meet operations with different parameter n: 1 for join, 2 for meet *) - let combined_event_list lattice_op (xs:event list) = - let l = match lattice_op with `Join -> 1 | `Meet -> 2 in - let aux (interval_count, acc) = function - | Enter x -> (interval_count + 1, if (interval_count + 1) >= l && interval_count < l then (Enter x)::acc else acc) - | Exit x -> (interval_count - 1, if interval_count >= l && (interval_count - 1) < l then (Exit x)::acc else acc) - in - List.fold_left aux (0, []) xs |> snd |> List.rev - - let rec events_to_intervals = function - | [] -> [] - | (Enter x)::(Exit y)::xs -> (x, y)::(events_to_intervals xs) - | _ -> failwith "Invalid events list" - - let remove_empty_gaps (xs: t) = - let aux acc (l, r) = match acc with - | ((a, b)::acc') when (b +. Ints_t.one) >=. l -> (a, r)::acc' - | _ -> (l, r)::acc - in - List.fold_left aux [] xs |> List.rev - - let canonize (xs: t) = - interval_set_to_events xs |> - List.sort cmp_events |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let unop (x: t) op = match x with - | [] -> [] - | _ -> canonize @@ List.concat_map op x - - let binop (x: t) (y: t) op : t = match x, y with - | [], _ -> [] - | _, [] -> [] - | _, _ -> canonize @@ List.concat_map op (BatList.cartesian_product x y) - - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let minimal = function - | [] -> None - | (x, _)::_ -> Some x - - let maximal = function - | [] -> None - | xs -> Some (BatList.last xs |> snd) - - let equal_to_interval i (a, b) = - if a =. b && b =. i then - `Eq - else if a <=. i && i <=. b then - `Top - else - `Neq - - let equal_to i xs = match List.map (equal_to_interval i) xs with - | [] -> failwith "unsupported: equal_to with bottom" - | [`Eq] -> `Eq - | ys when List.for_all ((=) `Neq) ys -> `Neq - | _ -> `Top - - let norm_interval ?(suppress_ovwarn=false) ?(cast=false) ik (x,y) : t*overflow_info = - if x >. y then - ([],{underflow=false; overflow=false}) - else - let (min_ik, max_ik) = range ik in - let underflow = min_ik >. x in - let overflow = max_ik <. y in - let v = if underflow || overflow then - begin - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (max_ik -. min_ik) in - let resdiff = Ints_t.abs (y -. x) in - if resdiff >. diff then - [range ik] - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if l <=. u then - [(l, u)] - else - (* Interval that wraps around (begins to the right of its end). We CAN represent such intervals *) - [(min_ik, u); (l, max_ik)] - else if not cast && should_ignore_overflow ik then - [Ints_t.max min_ik x, Ints_t.min max_ik y] - else - [range ik] - end - else - [(x,y)] - in - if suppress_ovwarn then (v, {underflow=false; overflow=false}) else (v, {underflow; overflow}) - - let norm_intvs ?(suppress_ovwarn=false) ?(cast=false) (ik:ikind) (xs: t) : t*overflow_info = - let res = List.map (norm_interval ~suppress_ovwarn ~cast ik) xs in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let binary_op_with_norm op (ik:ikind) (x: t) (y: t) : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> norm_intvs ik @@ List.concat_map (fun (x,y) -> [op x y]) (BatList.cartesian_product x y) - - let binary_op_with_ovc (x: t) (y: t) op : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> - let res = List.map op (BatList.cartesian_product x y) in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let unary_op_with_norm op (ik:ikind) (x: t) = match x with - | [] -> ([],{overflow=false; underflow=false}) - | _ -> norm_intvs ik @@ List.concat_map (fun x -> [op x]) x - - let rec leq (xs: t) (ys: t) = - let leq_interval (al, au) (bl, bu) = al >=. bl && au <=. bu in - match xs, ys with - | [], _ -> true - | _, [] -> false - | (xl,xr)::xs', (yl,yr)::ys' -> - if leq_interval (xl,xr) (yl,yr) then - leq xs' ys - else if xr <. yl then - false - else - leq xs ys' - - let join ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let meet ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Meet |> - events_to_intervals - - let to_int = function - | [x] -> IArith.to_int x - | _ -> None - - let zero = [IArith.zero] - let one = [IArith.one] - let top_bool = [IArith.top_bool] - - let not_bool (x:t) = - let is_false x = equal x zero in - let is_true x = equal x one in - if is_true x then zero else if is_false x then one else top_bool - - let to_bool = function - | [(l,u)] when l =. Ints_t.zero && u =. Ints_t.zero -> Some false - | x -> if leq zero x then None else Some true - - let of_bool _ = function true -> one | false -> zero - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm_interval ~suppress_ovwarn ~cast:false ik (x,y) - - let of_int ik (x: int_t) = of_interval ik (x, x) - - let lt ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <. min_y then - of_bool ik true - else if min_x >=. max_y then - of_bool ik false - else - top_bool - - let le ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <=. min_y then - of_bool ik true - else if min_x >. max_y then - of_bool ik false - else - top_bool - - let gt ik x y = not_bool @@ le ik x y - - let ge ik x y = not_bool @@ lt ik x y - - let eq ik x y = match x, y with - | (a, b)::[], (c, d)::[] when a =. b && c =. d && a =. c -> - one - | _ -> - if is_bot (meet ik x y) then - zero - else - top_bool - - let ne ik x y = not_bool @@ eq ik x y - let interval_to_int i = Interval.to_int (Some i) - let interval_to_bool i = Interval.to_bool (Some i) - - let log f ik (i1, i2) = - match (interval_to_bool i1, interval_to_bool i2) with - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - - let bit f ik (i1, i2) = - match (interval_to_int i1), (interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - - let bitcomp f ik (i1, i2) = - match (interval_to_int i1, interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{overflow=false; underflow=false})) - | _, _ -> (top_of ik,{overflow=false; underflow=false}) - - let logand ik x y = - let interval_logand = bit Ints_t.logand ik in - binop x y interval_logand - - let logor ik x y = - let interval_logor = bit Ints_t.logor ik in - binop x y interval_logor - - let logxor ik x y = - let interval_logxor = bit Ints_t.logxor ik in - binop x y interval_logxor - - let lognot ik x = - let interval_lognot i = - match interval_to_int i with - | Some x -> of_int ik (Ints_t.lognot x) |> fst - | _ -> top_of ik - in - unop x interval_lognot - - let shift_left ik x y = - let interval_shiftleft = bitcomp (fun x y -> Ints_t.shift_left x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftleft - - let shift_right ik x y = - let interval_shiftright = bitcomp (fun x y -> Ints_t.shift_right x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftright - - let c_lognot ik x = - let log1 f ik i1 = - match interval_to_bool i1 with - | Some x -> of_bool ik (f x) - | _ -> top_of ik - in - let interval_lognot = log1 not ik in - unop x interval_lognot - - let c_logand ik x y = - let interval_logand = log (&&) ik in - binop x y interval_logand - - let c_logor ik x y = - let interval_logor = log (||) ik in - binop x y interval_logor - - let add ?no_ov = binary_op_with_norm IArith.add - let sub ?no_ov = binary_op_with_norm IArith.sub - let mul ?no_ov = binary_op_with_norm IArith.mul - let neg ?no_ov = unary_op_with_norm IArith.neg - - let div ?no_ov ik x y = - let rec interval_div x (y1, y2) = begin - let top_of ik = top_of ik |> List.hd in - let is_zero v = v =. Ints_t.zero in - match y1, y2 with - | l, u when is_zero l && is_zero u -> top_of ik (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> interval_div x (Ints_t.one,y2) - | _, u when is_zero u -> interval_div x (y1, Ints_t.(neg one)) - | _ when leq (of_int ik (Ints_t.zero) |> fst) ([(y1,y2)]) -> top_of ik - | _ -> IArith.div x (y1, y2) - end - in binary_op_with_norm interval_div ik x y - - let rem ik x y = - let interval_rem (x, y) = - if Interval.is_top_of ik (Some x) && Interval.is_top_of ik (Some y) then - top_of ik - else - let (xl, xu) = x in let (yl, yu) = y in - let pos x = if x <. Ints_t.zero then Ints_t.neg x else x in - let b = (Ints_t.max (pos yl) (pos yu)) -. Ints_t.one in - let range = if xl >=. Ints_t.zero then (Ints_t.zero, Ints_t.min xu b) else (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit Ints_t.rem ik (x, y)) [range] - in - binop x y interval_rem - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik x = norm_intvs ~cast:true ik x - - (* - narrows down the extremeties of xs if they are equal to boundary values of the ikind with (possibly) narrower values from ys - *) - let narrow ik xs ys = match xs ,ys with - | [], _ -> [] | _ ,[] -> xs - | _, _ -> - let min_xs = minimal xs |> Option.get in - let max_xs = maximal xs |> Option.get in - let min_ys = minimal ys |> Option.get in - let max_ys = maximal ys |> Option.get in - let min_range,max_range = range ik in - let threshold = get_interval_threshold_widening () in - let min = if min_xs =. min_range || threshold && min_ys >. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in - let max = if max_xs =. max_range || threshold && max_ys <. max_xs && IArith.is_upper_threshold max_xs then max_ys else max_xs in - xs - |> (function (_, y)::z -> (min, y)::z | _ -> []) - |> List.rev - |> (function (x, _)::z -> (x, max)::z | _ -> []) - |> List.rev - - (* - 1. partitions the intervals of xs by assigning each of them to the an interval in ys that includes it. - and joins all intervals in xs assigned to the same interval in ys as one interval. - 2. checks for every pair of adjacent pairs whether the pairs did approach (if you compare the intervals from xs and ys) and merges them if it is the case. - 3. checks whether partitions at the extremeties are approaching infinity (and expands them to infinity. in that case) - - The expansion (between a pair of adjacent partitions or at extremeties ) stops at a threshold. - *) - let widen ik xs ys = - let (min_ik,max_ik) = range ik in - let threshold = get_bool "ana.int.interval_threshold_widening" in - let upper_threshold (_,u) = IArith.upper_threshold u max_ik in - let lower_threshold (l,_) = IArith.lower_threshold l min_ik in - (*obtain partitioning of xs intervals according to the ys interval that includes them*) - let rec interval_sets_to_partitions (ik: ikind) (acc : (int_t * int_t) option) (xs: t) (ys: t)= - match xs,ys with - | _, [] -> [] - | [], (y::ys) -> (acc,y):: interval_sets_to_partitions ik None [] ys - | (x::xs), (y::ys) when Interval.leq (Some x) (Some y) -> interval_sets_to_partitions ik (Interval.join ik acc (Some x)) xs (y::ys) - | (x::xs), (y::ys) -> (acc,y) :: interval_sets_to_partitions ik None (x::xs) ys - in - let interval_sets_to_partitions ik xs ys = interval_sets_to_partitions ik None xs ys in - (*merge a pair of adjacent partitions*) - let merge_pair ik (a,b) (c,d) = - let new_a = function - | None -> Some (upper_threshold b, upper_threshold b) - | Some (ax,ay) -> Some (ax, upper_threshold b) - in - let new_c = function - | None -> Some (lower_threshold d, lower_threshold d) - | Some (cx,cy) -> Some (lower_threshold d, cy) - in - if threshold && (lower_threshold d +. Ints_t.one) >. (upper_threshold b) then - [(new_a a,(fst b, upper_threshold b)); (new_c c, (lower_threshold d, snd d))] - else - [(Interval.join ik a c, (Interval.join ik (Some b) (Some d) |> Option.get))] - in - let partitions_are_approaching part_left part_right = match part_left, part_right with - | (Some (_, left_x), (_, left_y)), (Some (right_x, _), (right_y, _)) -> (right_x -. left_x) >. (right_y -. left_y) - | _,_ -> false - in - (*merge all approaching pairs of adjacent partitions*) - let rec merge_list ik = function - | [] -> [] - | x::y::xs when partitions_are_approaching x y -> merge_list ik ((merge_pair ik x y) @ xs) - | x::xs -> x :: merge_list ik xs - in - (*expands left extremity*) - let widen_left = function - | [] -> [] - | (None,(lb,rb))::ts -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (None, (lt,rb))::ts - | (Some (la,ra), (lb,rb))::ts when lb <. la -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (Some (la,ra),(lt,rb))::ts - | x -> x - in - (*expands right extremity*) - let widen_right x = - let map_rightmost = function - | [] -> [] - | (None,(lb,rb))::ts -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (None, (lb,ut))::ts - | (Some (la,ra), (lb,rb))::ts when ra <. rb -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (Some (la,ra),(lb,ut))::ts - | x -> x - in - List.rev x |> map_rightmost |> List.rev - in - interval_sets_to_partitions ik xs ys |> merge_list ik |> widen_left |> widen_right |> List.map snd - - let starting ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (fst (range ik), n) - - let invariant_ikind e ik xs = - List.map (fun x -> Interval.invariant_ikind e ik (Some x)) xs |> - let open Invariant in List.fold_left (||) (bot ()) - - let modulo n k = - let result = Ints_t.rem n k in - if result >=. Ints_t.zero then result - else result +. k - - let refine_with_congruence ik (intvs: t) (cong: (int_t * int_t ) option): t = - let refine_with_congruence_interval ik (cong : (int_t * int_t ) option) (intv : (int_t * int_t ) option): t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if m =. Ints_t.zero && (c <. x || c >. y) then [] - else if m =. Ints_t.zero then - [(c, c)] - else - let (min_ik, max_ik) = range ik in - let rcx = - if x =. min_ik then x else - x +. (modulo (c -. x) (Ints_t.abs m)) in - let lcy = - if y =. max_ik then y else - y -. (modulo (y -. c) (Ints_t.abs m)) in - if rcx >. lcy then [] - else if rcx =. lcy then norm_interval ik (rcx, rcx) |> fst - else norm_interval ik (rcx, lcy) |> fst - | _ -> [] - in - List.concat_map (fun x -> refine_with_congruence_interval ik cong (Some x)) intvs - - let refine_with_interval ik xs = function None -> [] | Some (a,b) -> meet ik xs [(a,b)] - - let refine_with_incl_list ik intvs = function - | None -> intvs - | Some xs -> meet ik intvs (List.map (fun x -> (x,x)) xs) - - let excl_range_to_intervalset (ik: ikind) ((min, max): int_t * int_t) (excl: int_t): t = - let intv1 = (min, excl -. Ints_t.one) in - let intv2 = (excl +. Ints_t.one, max) in - norm_intvs ik ~suppress_ovwarn:true [intv1 ; intv2] |> fst - - let of_excl_list ik (excls: int_t list) = - let excl_list = List.map (excl_range_to_intervalset ik (range ik)) excls in - let res = List.fold_left (meet ik) (top_of ik) excl_list in - res - - let refine_with_excl_list ik (intv : t) = function - | None -> intv - | Some (xs, range) -> - let excl_to_intervalset (ik: ikind) ((rl, rh): (int64 * int64)) (excl: int_t): t = - excl_range_to_intervalset ik (Ints_t.of_bigint (Size.min_from_bit_range rl),Ints_t.of_bigint (Size.max_from_bit_range rh)) excl - in - let excl_list = List.map (excl_to_intervalset ik range) xs in - List.fold_left (meet ik) intv excl_list - - let project ik p t = t - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let list_pair_arb = QCheck.small_list pair_arb in - let canonize_randomly_generated_list = (fun x -> norm_intvs ik x |> fst) in - let shrink xs = GobQCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list - in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) canonize_randomly_generated_list list_pair_arb) -end - -module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct - include D - - let add ?no_ov ik x y = fst @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = fst @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = fst @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = fst @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = fst @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = fst @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = fst @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = fst @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = fst @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = fst @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = fst @@ D.shift_left ik x y - - let shift_right ik x y = fst @@ D.shift_right ik x y -end - -module IntIkind = struct let ikind () = Cil.IInt end -module Interval = IntervalFunctor (IntOps.BigIntOps) -module Interval32 = IntDomWithDefaultIkind (IntDomLifter (SOverflowUnlifter (IntervalFunctor (IntOps.Int64Ops)))) (IntIkind) -module IntervalSet = IntervalSetFunctor (IntOps.BigIntOps) -module Integers (Ints_t : IntOps.IntOps): IkindUnawareS with type t = Ints_t.t and type int_t = Ints_t.t = (* no top/bot, order is <= *) -struct - include Printable.Std - let name () = "integers" - type t = Ints_t.t [@@deriving eq, ord, hash] - type int_t = Ints_t.t - let top () = raise Unknown - let bot () = raise Error - let top_of ik = top () - let bot_of ik = bot () - let show (x: Ints_t.t) = Ints_t.to_string x - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - (* is_top and is_bot are never called, but if they were, the Std impl would raise their exception, so we overwrite them: *) - let is_top _ = false - let is_bot _ = false - - let equal_to i x = if i > x then `Neq else `Top - let leq x y = x <= y - let join x y = if Ints_t.compare x y > 0 then x else y - let widen = join - let meet x y = if Ints_t.compare x y > 0 then y else x - let narrow = meet - - let of_bool x = if x then Ints_t.one else Ints_t.zero - let to_bool' x = x <> Ints_t.zero - let to_bool x = Some (to_bool' x) - let of_int x = x - let to_int x = Some x - - let neg = Ints_t.neg - let add = Ints_t.add (* TODO: signed overflow is undefined behavior! *) - let sub = Ints_t.sub - let mul = Ints_t.mul - let div = Ints_t.div - let rem = Ints_t.rem - let lt n1 n2 = of_bool (n1 < n2) - let gt n1 n2 = of_bool (n1 > n2) - let le n1 n2 = of_bool (n1 <= n2) - let ge n1 n2 = of_bool (n1 >= n2) - let eq n1 n2 = of_bool (n1 = n2) - let ne n1 n2 = of_bool (n1 <> n2) - let lognot = Ints_t.lognot - let logand = Ints_t.logand - let logor = Ints_t.logor - let logxor = Ints_t.logxor - let shift_left n1 n2 = Ints_t.shift_left n1 (Ints_t.to_int n2) - let shift_right n1 n2 = Ints_t.shift_right n1 (Ints_t.to_int n2) - let c_lognot n1 = of_bool (not (to_bool' n1)) - let c_logand n1 n2 = of_bool ((to_bool' n1) && (to_bool' n2)) - let c_logor n1 n2 = of_bool ((to_bool' n1) || (to_bool' n2)) - let cast_to ?(suppress_ovwarn=false) ?torg t x = failwith @@ "Cast_to not implemented for " ^ (name ()) ^ "." - let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 (* TODO: use ikind *) - let invariant _ _ = Invariant.none (* TODO *) -end - -module FlatPureIntegers: IkindUnawareS with type t = int64 and type int_t = int64 = (* Integers, but raises Unknown/Error on join/meet *) -struct - include Integers(IntOps.Int64Ops) - let top () = raise Unknown - let bot () = raise Error - let leq = equal - let pretty_diff () (x,y) = Pretty.dprintf "Integer %a instead of %a" pretty x pretty y - let join x y = if equal x y then x else top () - let meet x y = if equal x y then x else bot () -end - -module Flat (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) -struct - type int_t = Base.int_t - include Lattice.FlatConf (struct - include Printable.DefaultConf - let top_name = "Unknown int" - let bot_name = "Error int" - end) (Base) - - let top_of ik = top () - let bot_of ik = bot () - - - let name () = "flat integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ikind x = top_of ikind - let ending ?(suppress_ovwarn=false) ikind x = top_of ikind - let maximal x = None - let minimal x = None - - let lift1 f x = match x with - | `Lifted x -> - (try `Lifted (f x) with Unknown -> `Top | Error -> `Bot) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> - (try `Lifted (f x y) with Unknown -> `Top | Error -> `Bot) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Lift (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) -struct - include Lattice.LiftPO (struct - include Printable.DefaultConf - let top_name = "MaxInt" - let bot_name = "MinInt" - end) (Base) - type int_t = Base.int_t - let top_of ik = top () - let bot_of ik = bot () - include StdTop (struct type nonrec t = t let top_of = top_of end) - - let name () = "lifted integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let lift1 f x = match x with - | `Lifted x -> `Lifted (f x) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> `Lifted (f x y) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Flattened = Flat (Integers (IntOps.Int64Ops)) -module Lifted = Lift (Integers (IntOps.Int64Ops)) - -module Reverse (Base: IkindUnawareS) = -struct - include Base - include (Lattice.Reverse (Base) : Lattice.S with type t := Base.t) -end - -module BISet = struct - include SetDomain.Make (IntOps.BigIntOps) - let is_singleton s = cardinal s = 1 -end - -(* The module [Exclusion] constains common functionality about handling of exclusion sets between [DefExc] and [Enums] *) -module Exclusion = -struct - module R = Interval32 - (* We use these types for the functions in this module to make the intended meaning more explicit *) - type t = Exc of BISet.t * Interval32.t - type inc = Inc of BISet.t [@@unboxed] - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.succ (Z.add (Z.neg (min_of_range r)) (max_of_range r)) - - let cardinality_BISet s = - Z.of_int (BISet.cardinal s) - - let leq_excl_incl (Exc (xs, r)) (Inc ys) = - (* For a <= b to hold, the cardinalities must fit, i.e. |a| <= |b|, which implies |min_r, max_r| - |xs| <= |ys|. We check this first. *) - let lower_bound_cardinality_a = Z.sub (cardinality_of_range r) (cardinality_BISet xs) in - let card_b = cardinality_BISet ys in - if Z.compare lower_bound_cardinality_a card_b > 0 then - false - else (* The cardinality did fit, so we check for all elements that are represented by range r, whether they are in (xs union ys) *) - let min_a = min_of_range r in - let max_a = max_of_range r in - GobZ.for_all_range (fun el -> BISet.mem el xs || BISet.mem el ys) (min_a, max_a) - - let leq (Exc (xs, r)) (Exc (ys, s)) = - let min_a, max_a = min_of_range r, max_of_range r in - let excluded_check = BISet.for_all (fun y -> BISet.mem y xs || Z.compare y min_a < 0 || Z.compare y max_a > 0) ys in (* if true, then the values ys, that are not in b, also do not occur in a *) - if not excluded_check - then false - else begin (* Check whether all elements that are in the range r, but not in s, are in xs, i.e. excluded. *) - if R.leq r s then true - else begin if Z.compare (cardinality_BISet xs) (Z.sub (cardinality_of_range r) (cardinality_of_range s)) >= 0 (* Check whether the number of excluded elements in a is as least as big as |min_r, max_r| - |min_s, max_s| *) - then - let min_b, max_b = min_of_range s, max_of_range s in - let leq1 = (* check whether the elements in [r_l; s_l-1] are all in xs, i.e. excluded *) - if Z.compare min_a min_b < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (min_a, Z.pred min_b) - else - true - in - let leq2 () = (* check whether the elements in [s_u+1; r_u] are all in xs, i.e. excluded *) - if Z.compare max_b max_a < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (Z.succ max_b, max_a) - else - true - in - leq1 && (leq2 ()) - else - false - end - end -end - -module DefExc : S with type int_t = Z.t = (* definite or set of excluded values *) -struct - module S = BISet - module R = Interval32 (* range for exclusion *) - - (* Ikind used for intervals representing the domain *) - let range_ikind = Cil.IInt - let size t = R.of_interval range_ikind (let a,b = Size.bits_i64 t in Int64.neg a,b) - - - type t = [ - | `Excluded of S.t * R.t - | `Definite of Z.t - | `Bot - ] [@@deriving eq, ord, hash] - type int_t = Z.t - let name () = "def_exc" - - - let top_range = R.of_interval range_ikind (-99L, 99L) (* Since there is no top ikind we use a range that includes both ILongLong [-63,63] and IULongLong [0,64]. Only needed for intermediate range computation on longs. Correct range is set by cast. *) - let top () = `Excluded (S.empty (), top_range) - let bot () = `Bot - let top_of ik = `Excluded (S.empty (), size ik) - let bot_of ik = bot () - - let show x = - let short_size x = "("^R.show x^")" in - match x with - | `Bot -> "Error int" - | `Definite x -> Z.to_string x - (* Print the empty exclusion as if it was a distinct top element: *) - | `Excluded (s,l) when S.is_empty s -> "Unknown int" ^ short_size l - (* Prepend the exclusion sets with something: *) - | `Excluded (s,l) -> "Not " ^ S.show s ^ short_size l - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let maximal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.max_of_range r) - | `Bot -> None - - let minimal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.min_of_range r) - | `Bot -> None - - let in_range r i = - if Z.compare i Z.zero < 0 then - let lowerb = Exclusion.min_of_range r in - Z.compare lowerb i <= 0 - else - let upperb = Exclusion.max_of_range r in - Z.compare i upperb <= 0 - - let is_top x = x = top () - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Definite x -> if i = x then `Eq else `Neq - | `Excluded (s,r) -> if S.mem i s then `Neq else `Top - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik = function - | `Excluded (s,r) -> - let r' = size ik in - if R.leq r r' then (* upcast -> no change *) - `Excluded (s, r) - else if ik = IBool then (* downcast to bool *) - if S.mem Z.zero s then - `Definite Z.one - else - `Excluded (S.empty(), r') - else - (* downcast: may overflow *) - (* let s' = S.map (Size.cast ik) s in *) - (* We want to filter out all i in s' where (t)x with x in r could be i. *) - (* Since this is hard to compute, we just keep all i in s' which overflowed, since those are safe - all i which did not overflow may now be possible due to overflow of r. *) - (* S.diff s' s, r' *) - (* The above is needed for test 21/03, but not sound! See example https://github.com/goblint/analyzer/pull/95#discussion_r483023140 *) - `Excluded (S.empty (), r') - | `Definite x -> `Definite (Size.cast ik x) - | `Bot -> `Bot - - (* Wraps definite values and excluded values according to the ikind. - * For an `Excluded s,r , assumes that r is already an overapproximation of the range of possible values. - * r might be larger than the possible range of this type; the range of the returned `Excluded set will be within the bounds of the ikind. - *) - let norm ik v = - match v with - | `Excluded (s, r) -> - let possibly_overflowed = not (R.leq r (size ik)) || not (S.for_all (in_range (size ik)) s) in - (* If no overflow occurred, just return x *) - if not possibly_overflowed then ( - v - ) - (* Else, if an overflow might have occurred but we should just ignore it *) - else if should_ignore_overflow ik then ( - let r = size ik in - (* filter out excluded elements that are not in the range *) - let mapped_excl = S.filter (in_range r) s in - `Excluded (mapped_excl, r) - ) - (* Else, if an overflow occurred that we should not treat with wrap-around, go to top *) - else if not (should_wrap ik) then ( - top_of ik - ) else ( - (* Else an overflow occurred that we should treat with wrap-around *) - let r = size ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - let mapped_excl = S.map (fun excl -> Size.cast ik excl) s in - match ik with - | IBool -> - begin match S.mem Z.zero mapped_excl, S.mem Z.one mapped_excl with - | false, false -> `Excluded (mapped_excl, r) (* Not {} -> Not {} *) - | true, false -> `Definite Z.one (* Not {0} -> 1 *) - | false, true -> `Definite Z.zero (* Not {1} -> 0 *) - | true, true -> `Bot (* Not {0, 1} -> bot *) - end - | ik -> - `Excluded (mapped_excl, r) - ) - | `Definite x -> - let min, max = Size.range ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - if should_wrap ik then ( - cast_to ik v - ) - else if Z.compare min x <= 0 && Z.compare x max <= 0 then ( - v - ) - else if should_ignore_overflow ik then ( - M.warn ~category:M.Category.Integer.overflow "DefExc: Value was outside of range, indicating overflow, but 'sem.int.signed_overflow' is 'assume_none' -> Returned Bot"; - `Bot - ) - else ( - top_of ik - ) - | `Bot -> `Bot - - let leq x y = match (x,y) with - (* `Bot <= x is always true *) - | `Bot, _ -> true - (* Anything except bot <= bot is always false *) - | _, `Bot -> false - (* Two known values are leq whenever equal *) - | `Definite (x: int_t), `Definite y -> x = y - (* A definite value is leq all exclusion sets that don't contain it *) - | `Definite x, `Excluded (s,r) -> in_range r x && not (S.mem x s) - (* No finite exclusion set can be leq than a definite value *) - | `Excluded (xs, xr), `Definite d -> - Exclusion.(leq_excl_incl (Exc (xs, xr)) (Inc (S.singleton d))) - | `Excluded (xs,xr), `Excluded (ys,yr) -> - Exclusion.(leq (Exc (xs,xr)) (Exc (ys, yr))) - - let join' ?range ik x y = - match (x,y) with - (* The least upper bound with the bottom element: *) - | `Bot, x -> x - | x, `Bot -> x - (* The case for two known values: *) - | `Definite (x: int_t), `Definite y -> - (* If they're equal, it's just THAT value *) - if x = y then `Definite x - (* Unless one of them is zero, we can exclude it: *) - else - let a,b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval range_ikind a) (R.of_interval range_ikind b) in - `Excluded ((if Z.equal x Z.zero || Z.equal y Z.zero then S.empty () else S.singleton Z.zero), r) - (* A known value and an exclusion set... the definite value should no - * longer be excluded: *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> - if not (in_range r x) then - let a = R.of_interval range_ikind (Size.min_range_sign_agnostic x) in - `Excluded (S.remove x s, R.join a r) - else - `Excluded (S.remove x s, r) - (* For two exclusion sets, only their intersection can be excluded: *) - | `Excluded (x,wx), `Excluded (y,wy) -> `Excluded (S.inter x y, range |? R.join wx wy) - - let join ik = join' ik - - - let widen ik x y = - if get_def_exc_widen_by_join () then - join' ik x y - else if equal x y then - x - else - join' ~range:(size ik) ik x y - - - let meet ik x y = - match (x,y) with - (* Greatest LOWER bound with the least element is trivial: *) - | `Bot, _ -> `Bot - | _, `Bot -> `Bot - (* Definite elements are either equal or the glb is bottom *) - | `Definite x, `Definite y -> if x = y then `Definite x else `Bot - (* The glb of a definite element and an exclusion set is either bottom or - * just the element itself, if it isn't in the exclusion set *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> if S.mem x s || not (in_range r x) then `Bot else `Definite x - (* The greatest lower bound of two exclusion sets is their union, this is - * just DeMorgans Law *) - | `Excluded (x,r1), `Excluded (y,r2) -> - let r' = R.meet r1 r2 in - let s' = S.union x y |> S.filter (in_range r') in - `Excluded (s', r') - - let narrow ik x y = x - - let of_int ik x = norm ik @@ `Definite x - let to_int x = match x with - | `Definite x -> Some x - | _ -> None - - let from_excl ikind (s: S.t) = norm ikind @@ `Excluded (s, size ikind) - - let of_bool_cmp ik x = of_int ik (if x then Z.one else Z.zero) - let of_bool = of_bool_cmp - let to_bool x = - match x with - | `Definite x -> Some (IntOps.BigIntOps.to_bool x) - | `Excluded (s,r) when S.mem Z.zero s -> Some true - | _ -> None - let top_bool = `Excluded (S.empty (), R.of_interval range_ikind (0L, 1L)) - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = - if Z.compare x y = 0 then - of_int ik x - else - let a, b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval ~suppress_ovwarn range_ikind a) (R.of_interval ~suppress_ovwarn range_ikind b) in - let ex = if Z.gt x Z.zero || Z.lt y Z.zero then S.singleton Z.zero else S.empty () in - norm ik @@ (`Excluded (ex, r)) - - let starting ?(suppress_ovwarn=false) ikind x = - let _,u_ik = Size.range ikind in - of_interval ~suppress_ovwarn ikind (x, u_ik) - - let ending ?(suppress_ovwarn=false) ikind x = - let l_ik,_ = Size.range ikind in - of_interval ~suppress_ovwarn ikind (l_ik, x) - - let of_excl_list t l = - let r = size t in (* elements in l are excluded from the full range of t! *) - `Excluded (List.fold_right S.add l (S.empty ()), r) - let is_excl_list l = match l with `Excluded _ -> true | _ -> false - let to_excl_list (x:t) = match x with - | `Definite _ -> None - | `Excluded (s,r) -> Some (S.elements s, (Option.get (R.minimal r), Option.get (R.maximal r))) - | `Bot -> None - - let to_incl_list x = match x with - | `Definite x -> Some [x] - | `Excluded _ -> None - | `Bot -> None - - let apply_range f r = (* apply f to the min/max of the old range r to get a new range *) - (* If the Int64 might overflow on us during computation, we instead go to top_range *) - match R.minimal r, R.maximal r with - | _ -> - let rf m = (size % Size.min_for % f) (m r) in - let r1, r2 = rf Exclusion.min_of_range, rf Exclusion.max_of_range in - R.join r1 r2 - - (* Default behaviour for unary operators, simply maps the function to the - * DefExc data structure. *) - let lift1 f ik x = norm ik @@ match x with - | `Excluded (s,r) -> - let s' = S.map f s in - `Excluded (s', apply_range f r) - | `Definite x -> `Definite (f x) - | `Bot -> `Bot - - let lift2 f ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite _ - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (f x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - (* Default behaviour for binary operators that are injective in either - * argument, so that Exclusion Sets can be used: *) - let lift2_inj f ik x y = - let def_exc f x s r = `Excluded (S.map (f x) s, apply_range (f x) r) in - norm ik @@ - match x,y with - (* If both are exclusion sets, there isn't anything we can do: *) - | `Excluded _, `Excluded _ -> top () - (* A definite value should be applied to all members of the exclusion set *) - | `Definite x, `Excluded (s,r) -> def_exc f x s r - (* Same thing here, but we should flip the operator to map it properly *) - | `Excluded (s,r), `Definite x -> def_exc (Batteries.flip f) x s r - (* The good case: *) - | `Definite x, `Definite y -> `Definite (f x y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The equality check: *) - let eq ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x equal to an exclusion set, if it is a member then NO otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt false else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt false else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x = y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The inequality check: *) - let ne ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x unequal to an exclusion set, if it is a member then Yes otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt true else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt true else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x <> y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - let neg ?no_ov ik (x :t) = norm ik @@ lift1 Z.neg ik x - let add ?no_ov ik x y = norm ik @@ lift2_inj Z.add ik x y - - let sub ?no_ov ik x y = norm ik @@ lift2_inj Z.sub ik x y - let mul ?no_ov ik x y = norm ik @@ match x, y with - | `Definite z, (`Excluded _ | `Definite _) when Z.equal z Z.zero -> x - | (`Excluded _ | `Definite _), `Definite z when Z.equal z Z.zero -> y - | `Definite a, `Excluded (s,r) - (* Integer multiplication with even numbers is not injective. *) - (* Thus we cannot exclude the values to which the exclusion set would be mapped to. *) - | `Excluded (s,r),`Definite a when Z.equal (Z.rem a (Z.of_int 2)) Z.zero -> `Excluded (S.empty (), apply_range (Z.mul a) r) - | _ -> lift2_inj Z.mul ik x y - let div ?no_ov ik x y = lift2 Z.div ik x y - let rem ik x y = lift2 Z.rem ik x y - - (* Comparison handling copied from Enums. *) - let handle_bot x y f = match x, y with - | `Bot, `Bot -> `Bot - | `Bot, _ - | _, `Bot -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> f () - - let lt ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 < 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 >= 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let gt ik x y = lt ik y x - - let le ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 <= 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 > 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let ge ik x y = le ik y x - - let lognot = lift1 Z.lognot - - let logand ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite i -> - (* Except in two special cases *) - if Z.equal i Z.zero then - `Definite Z.zero - else if Z.equal i Z.one then - of_interval IBool (Z.zero, Z.one) - else - top () - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (Z.logand x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - - let logor = lift2 Z.logor - let logxor = lift2 Z.logxor - - let shift (shift_op: int_t -> int -> int_t) (ik: Cil.ikind) (x: t) (y: t) = - (* BigInt only accepts int as second argument for shifts; perform conversion here *) - let shift_op_big_int a (b: int_t) = - let (b : int) = Z.to_int b in - shift_op a b - in - (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in - if is_negative (minimal x) || is_negative (minimal y) then - top_of ik - else - norm ik @@ lift2 shift_op_big_int ik x y - - let shift_left = - shift Z.shift_left - - let shift_right = - shift Z.shift_right - (* TODO: lift does not treat Not {0} as true. *) - let c_logand ik x y = - match to_bool x, to_bool y with - | Some false, _ - | _, Some false -> - of_bool ik false - | _, _ -> - lift2 IntOps.BigIntOps.c_logand ik x y - let c_logor ik x y = - match to_bool x, to_bool y with - | Some true, _ - | _, Some true -> - of_bool ik true - | _, _ -> - lift2 IntOps.BigIntOps.c_logor ik x y - let c_lognot ik = eq ik (of_int ik Z.zero) - - let invariant_ikind e ik (x:t) = - match x with - | `Definite x -> - IntInvariant.of_int e ik x - | `Excluded (s, r) -> - (* Emit range invariant if tighter than ikind bounds. - This can be more precise than interval, which has been widened. *) - let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let ri = IntInvariant.of_interval e ik (rmin, rmax) in - let si = IntInvariant.of_excl_list e ik (S.elements s) in - Invariant.(ri && si) - | `Bot -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - let excluded s = from_excl ik s in - let definite x = of_int ik x in - let shrink = function - | `Excluded (s, _) -> GobQCheck.shrink (S.arbitrary ()) s >|= excluded (* S TODO: possibly shrink excluded to definite *) - | `Definite x -> (return `Bot) <+> (GobQCheck.shrink (IntOps.BigIntOps.arbitrary ()) x >|= definite) - | `Bot -> empty - in - QCheck.frequency ~shrink ~print:show [ - 20, QCheck.map excluded (S.arbitrary ()); - 10, QCheck.map definite (IntOps.BigIntOps.arbitrary ()); - 1, QCheck.always `Bot - ] (* S TODO: decide frequencies *) - - let refine_with_congruence ik a b = a - let refine_with_interval ik a b = match a, b with - | x, Some(i) -> meet ik x (of_interval ik i) - | _ -> a - let refine_with_excl_list ik a b = match a, b with - | `Excluded (s, r), Some(ls, _) -> meet ik (`Excluded (s, r)) (of_excl_list ik ls) (* TODO: refine with excl range? *) - | _ -> a - let refine_with_incl_list ik a b = a - - let project ik p t = t -end - -(* 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. *) -module Enums : S with type int_t = Z.t = struct - module R = Interval32 (* range for exclusion *) - - let range_ikind = Cil.IInt - let size t = R.of_interval range_ikind (let a,b = Size.bits_i64 t in Int64.neg a,b) - - type t = Inc of BISet.t | Exc of BISet.t * R.t [@@deriving eq, ord, hash] (* inclusion/exclusion set *) - - type int_t = Z.t - let name () = "enums" - let bot () = failwith "bot () not implemented for Enums" - let top () = failwith "top () not implemented for Enums" - let bot_of ik = Inc (BISet.empty ()) - let top_bool = Inc (BISet.of_list [Z.zero; Z.one]) - let top_of ik = - match ik with - | IBool -> top_bool - | _ -> Exc (BISet.empty (), size ik) - - let range ik = Size.range ik - -(* - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.add (Z.neg (min_of_range r)) (max_of_range r) *) - let value_in_range (min, max) v = Z.compare min v <= 0 && Z.compare v max <= 0 - - let show = function - | Inc xs when BISet.is_empty xs -> "bot" - | Inc xs -> "{" ^ (String.concat ", " (List.map Z.to_string (BISet.elements xs))) ^ "}" - | Exc (xs,r) -> "not {" ^ (String.concat ", " (List.map Z.to_string (BISet.elements xs))) ^ "} " ^ "("^R.show r^")" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - (* Normalization function for enums, that handles overflows for Inc. - As we do not compute on Excl, we do not have to perform any overflow handling for it. *) - let norm ikind v = - let min, max = range ikind in - (* Whether the value v lies within the values of the specified ikind. *) - let value_in_ikind v = - Z.compare min v <= 0 && Z.compare v max <= 0 - in - match v with - | Inc xs when BISet.for_all value_in_ikind xs -> v - | Inc xs -> - if should_wrap ikind then - Inc (BISet.map (Size.cast ikind) xs) - else if should_ignore_overflow ikind then - Inc (BISet.filter value_in_ikind xs) - else - top_of ikind - | Exc (xs, r) -> - (* The following assert should hold for Exc, therefore we do not have to overflow handling / normalization for it: - let range_in_ikind r = - R.leq r (size ikind) - in - let r_min, r_max = min_of_range r, max_of_range r in - assert (range_in_ikind r && BISet.for_all (value_in_range (r_min, r_max)) xs); *) - begin match ikind with - | IBool -> - begin match BISet.mem Z.zero xs, BISet.mem Z.one xs with - | false, false -> top_bool (* Not {} -> {0, 1} *) - | true, false -> Inc (BISet.singleton Z.one) (* Not {0} -> {1} *) - | false, true -> Inc (BISet.singleton Z.zero) (* Not {1} -> {0} *) - | true, true -> bot_of ikind (* Not {0, 1} -> bot *) - end - | _ -> - v - end - - - let equal_to i = function - | Inc x -> - if BISet.mem i x then - if BISet.is_singleton x then `Eq - else `Top - else `Neq - | Exc (x, r) -> - if BISet.mem i x then `Neq - else `Top - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik v = norm ik @@ match v with - | Exc (s,r) -> - let r' = size ik in - if R.leq r r' then (* upcast -> no change *) - Exc (s, r) - else if ik = IBool then (* downcast to bool *) - if BISet.mem Z.zero s then - Inc (BISet.singleton Z.one) - else - Exc (BISet.empty(), r') - else (* downcast: may overflow *) - Exc ((BISet.empty ()), r') - | Inc xs -> - let casted_xs = BISet.map (Size.cast ik) xs in - if Cil.isSigned ik && not (BISet.equal xs casted_xs) - then top_of ik (* When casting into a signed type and the result does not fit, the behavior is implementation-defined *) - else Inc casted_xs - - let of_int ikind x = cast_to ikind (Inc (BISet.singleton x)) - - let of_interval ?(suppress_ovwarn=false) ik (x, y) = - if Z.compare x y = 0 then - of_int ik x - else - let a, b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval ~suppress_ovwarn range_ikind a) (R.of_interval ~suppress_ovwarn range_ikind b) in - let ex = if Z.gt x Z.zero || Z.lt y Z.zero then BISet.singleton Z.zero else BISet.empty () in - norm ik @@ (Exc (ex, r)) - - let join _ x y = - match x, y with - | Inc x, Inc y -> Inc (BISet.union x y) - | Exc (x,r1), Exc (y,r2) -> Exc (BISet.inter x y, R.join r1 r2) - | Exc (x,r), Inc y - | Inc y, Exc (x,r) -> - let r = if BISet.is_empty y - then r - else - let (min_el_range, max_el_range) = Batteries.Tuple2.mapn (fun x -> R.of_interval range_ikind (Size.min_range_sign_agnostic x)) (BISet.min_elt y, BISet.max_elt y) in - let range = R.join min_el_range max_el_range in - R.join r range - in - Exc (BISet.diff x y, r) - - let meet _ x y = - match x, y with - | Inc x, Inc y -> Inc (BISet.inter x y) - | Exc (x,r1), Exc (y,r2) -> - let r = R.meet r1 r2 in - let r_min, r_max = Exclusion.min_of_range r, Exclusion.max_of_range r in - let filter_by_range = BISet.filter (value_in_range (r_min, r_max)) in - (* We remove those elements from the exclusion set that do not fit in the range anyway *) - let excl = BISet.union (filter_by_range x) (filter_by_range y) in - Exc (excl, r) - | Inc x, Exc (y,r) - | Exc (y,r), Inc x -> Inc (BISet.diff x y) - - let widen = join - let narrow = meet - let leq a b = - match a, b with - | Inc xs, Exc (ys, r) -> - if BISet.is_empty xs - then true - else - let min_b, max_b = Exclusion.min_of_range r, Exclusion.max_of_range r in - let min_a, max_a = BISet.min_elt xs, BISet.max_elt xs in - (* Check that the xs fit into the range r *) - Z.compare min_b min_a <= 0 && Z.compare max_a max_b <= 0 && - (* && check that none of the values contained in xs is excluded, i.e. contained in ys. *) - BISet.for_all (fun x -> not (BISet.mem x ys)) xs - | Inc xs, Inc ys -> - BISet.subset xs ys - | Exc (xs, r), Exc (ys, s) -> - Exclusion.(leq (Exc (xs, r)) (Exc (ys, s))) - | Exc (xs, r), Inc ys -> - Exclusion.(leq_excl_incl (Exc (xs, r)) (Inc ys)) - - let handle_bot x y f = match is_bot x, is_bot y with - | false, false -> f () - | true, false - | false, true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | true, true -> Inc (BISet.empty ()) - - let lift1 f ikind v = norm ikind @@ match v with - | Inc x when BISet.is_empty x -> v (* Return bottom when value is bottom *) - | Inc x when BISet.is_singleton x -> Inc (BISet.singleton (f (BISet.choose x))) - | _ -> top_of ikind - - let lift2 f (ikind: Cil.ikind) u v = - handle_bot u v (fun () -> - norm ikind @@ match u, v with - | Inc x,Inc y when BISet.is_singleton x && BISet.is_singleton y -> Inc (BISet.singleton (f (BISet.choose x) (BISet.choose y))) - | _,_ -> top_of ikind) - - let lift2 f ikind a b = - try lift2 f ikind a b with Division_by_zero -> top_of ikind - - let neg ?no_ov = lift1 Z.neg - let add ?no_ov ikind a b = - match a, b with - | Inc z,x when BISet.is_singleton z && BISet.choose z = Z.zero -> x - | x,Inc z when BISet.is_singleton z && BISet.choose z = Z.zero -> x - | x,y -> lift2 Z.add ikind x y - let sub ?no_ov = lift2 Z.sub - let mul ?no_ov ikind a b = - match a, b with - | Inc one,x when BISet.is_singleton one && BISet.choose one = Z.one -> x - | x,Inc one when BISet.is_singleton one && BISet.choose one = Z.one -> x - | Inc zero,_ when BISet.is_singleton zero && BISet.choose zero = Z.zero -> a - | _,Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> b - | x,y -> lift2 Z.mul ikind x y - - let div ?no_ov ikind a b = match a, b with - | x,Inc one when BISet.is_singleton one && BISet.choose one = Z.one -> x - | _,Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> top_of ikind - | Inc zero,_ when BISet.is_singleton zero && BISet.choose zero = Z.zero -> a - | x,y -> lift2 Z.div ikind x y - - let rem = lift2 Z.rem - - let lognot = lift1 Z.lognot - let logand = lift2 Z.logand - let logor = lift2 Z.logor - let logxor = lift2 Z.logxor - - let shift (shift_op: int_t -> int -> int_t) (ik: Cil.ikind) (x: t) (y: t) = - handle_bot x y (fun () -> - (* BigInt only accepts int as second argument for shifts; perform conversion here *) - let shift_op_big_int a (b: int_t) = - let (b : int) = Z.to_int b in - shift_op a b - in - (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in - if is_negative (minimal x) || is_negative (minimal y) then - top_of ik - else - lift2 shift_op_big_int ik x y) - - let shift_left = - shift Z.shift_left - - let shift_right = - shift Z.shift_right - - let of_bool ikind x = Inc (BISet.singleton (if x then Z.one else Z.zero)) - let to_bool = function - | Inc e when BISet.is_empty e -> None - | Exc (e,_) when BISet.is_empty e -> None - | Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> Some false - | Inc xs when BISet.for_all ((<>) Z.zero) xs -> Some true - | Exc (xs,_) when BISet.exists ((=) Z.zero) xs -> Some true - | _ -> None - let to_int = function Inc x when BISet.is_singleton x -> Some (BISet.choose x) | _ -> None - - let to_excl_list = function Exc (x,r) when not (BISet.is_empty x) -> Some (BISet.elements x, (Option.get (R.minimal r), Option.get (R.maximal r))) | _ -> None - let of_excl_list ik xs = - let min_ik, max_ik = Size.range ik in - let exc = BISet.of_list @@ List.filter (value_in_range (min_ik, max_ik)) xs in - norm ik @@ Exc (exc, size ik) - let is_excl_list = BatOption.is_some % to_excl_list - let to_incl_list = function Inc s when not (BISet.is_empty s) -> Some (BISet.elements s) | _ -> None - - let starting ?(suppress_ovwarn=false) ikind x = - let _,u_ik = Size.range ikind in - of_interval ~suppress_ovwarn ikind (x, u_ik) - - let ending ?(suppress_ovwarn=false) ikind x = - let l_ik,_ = Size.range ikind in - of_interval ~suppress_ovwarn ikind (l_ik, x) - - let c_lognot ik x = - if is_bot x - then x - else - match to_bool x with - | Some b -> of_bool ik (not b) - | None -> top_bool - - let c_logand = lift2 IntOps.BigIntOps.c_logand - let c_logor = lift2 IntOps.BigIntOps.c_logor - let maximal = function - | Inc xs when not (BISet.is_empty xs) -> Some (BISet.max_elt xs) - | Exc (excl,r) -> - let rec decrement_while_contained v = - if BISet.mem v excl - then decrement_while_contained (Z.pred v) - else v - in - let range_max = Exclusion.max_of_range r in - Some (decrement_while_contained range_max) - | _ (* bottom case *) -> None - - let minimal = function - | Inc xs when not (BISet.is_empty xs) -> Some (BISet.min_elt xs) - | Exc (excl,r) -> - let rec increment_while_contained v = - if BISet.mem v excl - then increment_while_contained (Z.succ v) - else v - in - let range_min = Exclusion.min_of_range r in - Some (increment_while_contained range_min) - | _ (* bottom case *) -> None - - let lt ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 < 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 >= 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let gt ik x y = lt ik y x - - let le ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 <= 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 > 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let ge ik x y = le ik y x - - let eq ik x y = - handle_bot x y (fun () -> - match x, y with - | Inc xs, Inc ys when BISet.is_singleton xs && BISet.is_singleton ys -> of_bool ik (Z.equal (BISet.choose xs) (BISet.choose ys)) - | _, _ -> - if is_bot (meet ik x y) then - (* If the meet is empty, there is no chance that concrete values are equal *) - of_bool ik false - else - top_bool) - - let ne ik x y = c_lognot ik (eq ik x y) - - let invariant_ikind e ik x = - match x with - | Inc ps -> - IntInvariant.of_incl_list e ik (BISet.elements ps) - | Exc (ns, r) -> - (* Emit range invariant if tighter than ikind bounds. - This can be more precise than interval, which has been widened. *) - let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let ri = IntInvariant.of_interval e ik (rmin, rmax) in - let nsi = IntInvariant.of_excl_list e ik (BISet.elements ns) in - Invariant.(ri && nsi) - - - let arbitrary ik = - let open QCheck.Iter in - let neg s = of_excl_list ik (BISet.elements s) in - let pos s = norm ik (Inc s) in - let shrink = function - | Exc (s, _) -> GobQCheck.shrink (BISet.arbitrary ()) s >|= neg (* S TODO: possibly shrink neg to pos *) - | Inc s -> GobQCheck.shrink (BISet.arbitrary ()) s >|= pos - in - QCheck.frequency ~shrink ~print:show [ - 20, QCheck.map neg (BISet.arbitrary ()); - 10, QCheck.map pos (BISet.arbitrary ()); - ] (* S TODO: decide frequencies *) - - let refine_with_congruence ik a b = - let contains c m x = if Z.equal m Z.zero then Z.equal c x else Z.equal (Z.rem (Z.sub x c) m) Z.zero in - match a, b with - | Inc e, None -> bot_of ik - | Inc e, Some (c, m) -> Inc (BISet.filter (contains c m) e) - | _ -> a - - let refine_with_interval ik a b = a (* TODO: refine inclusion (exclusion?) set *) - - let refine_with_excl_list ik a b = - match b with - | Some (ls, _) -> meet ik a (of_excl_list ik ls) (* TODO: refine with excl range? *) - | _ -> a - - let refine_with_incl_list ik a b = - match a, b with - | Inc x, Some (ls) -> meet ik (Inc x) (Inc (BISet.of_list ls)) - | _ -> a - - let project ik p t = t -end module Congruence : S with type int_t = Z.t and type t = (Z.t * Z.t) option = struct @@ -3235,35 +493,3 @@ struct let project ik p t = t end - -module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct - - include D - - let lift v = (v, {overflow=false; underflow=false}) - - let add ?no_ov ik x y = lift @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = lift @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = lift @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = lift @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = lift @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = lift @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = lift @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = lift @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = lift @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = lift @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = lift @@ D.shift_left ik x y - - let shift_right ik x y = lift @@ D.shift_right ik x y - -end From 48fad68eb50a15778ad55dce114c15f65b5f4138 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:56:51 +0300 Subject: [PATCH 104/157] Remove Congruence from IntDomain0 --- src/cdomain/value/cdomains/intDomain0.ml | 493 ----------------------- 1 file changed, 493 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/intDomain0.ml index 7450e8a212..8dd8b07f74 100644 --- a/src/cdomain/value/cdomains/intDomain0.ml +++ b/src/cdomain/value/cdomains/intDomain0.ml @@ -2743,499 +2743,6 @@ module Enums : S with type int_t = Z.t = struct let project ik p t = t end -module Congruence : S with type int_t = Z.t and type t = (Z.t * Z.t) option = -struct - let name () = "congruences" - type int_t = Z.t - - (* represents congruence class of c mod m, None is bot *) - type t = (Z.t * Z.t) option [@@deriving eq, ord, hash] - - let ( *: ) = Z.mul - let (+:) = Z.add - let (-:) = Z.sub - let (%:) = Z.rem - let (/:) = Z.div - let (=:) = Z.equal - let (<:) x y = Z.compare x y < 0 - let (>:) x y = Z.compare x y > 0 - let (<=:) x y = Z.compare x y <= 0 - let (>=:) x y = Z.compare x y >= 0 - (* a divides b *) - let ( |: ) a b = - if a =: Z.zero then false else (b %: a) =: Z.zero - - let normalize ik x = - match x with - | None -> None - | Some (c, m) -> - if m =: Z.zero then - if should_wrap ik then - Some (Size.cast ik c, m) - else - Some (c, m) - else - let m' = Z.abs m in - let c' = c %: m' in - if c' <: Z.zero then - Some (c' +: m', m') - else - Some (c' %: m', m') - - let range ik = Size.range ik - - let top () = Some (Z.zero, Z.one) - let top_of ik = Some (Z.zero, Z.one) - let bot () = None - let bot_of ik = bot () - - let show = function ik -> match ik with - | None -> "⟂" - | Some (c, m) when (c, m) = (Z.zero, Z.zero) -> Z.to_string c - | Some (c, m) -> - let a = if c =: Z.zero then "" else Z.to_string c in - let b = if m =: Z.zero then "" else if m = Z.one then "ℤ" else Z.to_string m^"ℤ" in - let c = if a = "" || b = "" then "" else "+" in - a^c^b - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let is_top x = x = top () - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) when b =: Z.zero -> if a =: i then `Eq else `Neq - | Some (a, b) -> if i %: b =: a then `Top else `Neq - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (c1,m1), Some (c2,m2) when m2 =: Z.zero && m1 =: Z.zero -> c1 =: c2 - | Some (c1,m1), Some (c2,m2) when m2 =: Z.zero -> c1 =: c2 && m1 =: Z.zero - | Some (c1,m1), Some (c2,m2) -> m2 |: Z.gcd (c1 -: c2) m1 - (* Typo in original equation of P. Granger (m2 instead of m1): gcd (c1 -: c2) m2 - Reference: https://doi.org/10.1080/00207168908803778 Page 171 corollary 3.3*) - - let leq x y = - let res = leq x y in - if M.tracing then M.trace "congruence" "leq %a %a -> %a " pretty x pretty y pretty (Some (Z.of_int (Bool.to_int res), Z.zero)) ; - res - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (c1,m1), Some (c2,m2) -> - let m3 = Z.gcd m1 (Z.gcd m2 (c1 -: c2)) in - normalize ik (Some (c1, m3)) - - let join ik (x:t) y = - let res = join ik x y in - if M.tracing then M.trace "congruence" "join %a %a -> %a" pretty x pretty y pretty res; - res - - - let meet ik x y = - (* if it exists, c2/a2 is solution to a*x ≡ c (mod m) *) - let congruence_series a c m = - let rec next a1 c1 a2 c2 = - if a2 |: a1 then (a2, c2) - else next a2 c2 (a1 %: a2) (c1 -: (c2 *: (a1 /: a2))) - in next m Z.zero a c - in - let simple_case i c m = - if m |: (i -: c) - then Some (i, Z.zero) else None - in - match x, y with - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero && m2 =: Z.zero -> if c1 =: c2 then Some (c1, Z.zero) else None - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero -> simple_case c1 c2 m2 - | Some (c1, m1), Some (c2, m2) when m2 =: Z.zero -> simple_case c2 c1 m1 - | Some (c1, m1), Some (c2, m2) when (Z.gcd m1 m2) |: (c1 -: c2) -> - let (c, m) = congruence_series m1 (c2 -: c1 ) m2 in - normalize ik (Some(c1 +: (m1 *: (m /: c)), m1 *: (m2 /: c))) - | _ -> None - - let meet ik x y = - let res = meet ik x y in - if M.tracing then M.trace "congruence" "meet %a %a -> %a" pretty x pretty y pretty res; - res - - let to_int = function Some (c, m) when m =: Z.zero -> Some c | _ -> None - let of_int ik (x: int_t) = normalize ik @@ Some (x, Z.zero) - let zero = Some (Z.zero, Z.zero) - let one = Some (Z.one, Z.zero) - let top_bool = top() - - let of_bool _ik = function true -> one | false -> zero - - let to_bool (a: t) = match a with - | None -> None - | x when equal zero x -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = top() - - let ending = starting - - let of_congruence ik (c,m) = normalize ik @@ Some(c,m) - - let maximal t = match t with - | Some (x, y) when y =: Z.zero -> Some x - | _ -> None - - let minimal t = match t with - | Some (x,y) when y =: Z.zero -> Some x - | _ -> None - - (* cast from original type to ikind, set to top if the value doesn't fit into the new type *) - let cast_to ?(suppress_ovwarn=false) ?torg ?(no_ov=false) t x = - match x with - | None -> None - | Some (c, m) when m =: Z.zero -> - let c' = Size.cast t c in - (* When casting into a signed type and the result does not fit, the behavior is implementation-defined. (C90 6.2.1.2, C99 and C11 6.3.1.3) *) - (* We go with GCC behavior here: *) - (* For conversion to a type of width N, the value is reduced modulo 2^N to be within range of the type; no signal is raised. *) - (* (https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html) *) - (* Clang behaves the same but they never document that anywhere *) - Some (c', m) - | _ -> - let (min_t, max_t) = range t in - let p ikorg = - let (min_ikorg, max_ikorg) = range ikorg in - ikorg = t || (max_t >=: max_ikorg && min_t <=: min_ikorg) - in - match torg with - | Some (Cil.TInt (ikorg, _)) when p ikorg -> - if M.tracing then M.trace "cong-cast" "some case"; - x - | _ -> top () - - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov (t : Cil.ikind) x = - let pretty_bool _ x = Pretty.text (string_of_bool x) in - let res = cast_to ?torg ?no_ov t x in - if M.tracing then M.trace "cong-cast" "Cast %a to %a (no_ov: %a) = %a" pretty x Cil.d_ikind t (Pretty.docOpt (pretty_bool ())) no_ov pretty res; - res - - let widen = join - - let widen ik x y = - let res = widen ik x y in - if M.tracing then M.trace "congruence" "widen %a %a -> %a" pretty x pretty y pretty res; - res - - let narrow = meet - - let log f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) - let c_logand = log (&&) - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let shift_right _ _ _ = top() - - let shift_right ik x y = - let res = shift_right ik x y in - if M.tracing then M.trace "congruence" "shift_right : %a %a becomes %a " pretty x pretty y pretty res; - res - - let shift_left ik x y = - (* Naive primality test *) - (* let is_prime n = - let n = Z.abs n in - let rec is_prime' d = - (d *: d >: n) || ((not ((n %: d) =: Z.zero)) && (is_prime' [@tailcall]) (d +: Z.one)) - in - not (n =: Z.one) && is_prime' (Z.of_int 2) - in *) - match x, y with - | None, None -> None - | None, _ - | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c, m), Some (c', m') when Cil.isSigned ik || c <: Z.zero || c' <: Z.zero -> top_of ik - | Some (c, m), Some (c', m') -> - let (_, max_ik) = range ik in - if m =: Z.zero && m' =: Z.zero then - normalize ik @@ Some (Z.logand max_ik (Z.shift_left c (Z.to_int c')), Z.zero) - else - let x = Z.logand max_ik (Z.shift_left Z.one (Z.to_int c')) in (* 2^c' *) - (* TODO: commented out because fails test with _Bool *) - (* if is_prime (m' +: Z.one) then - normalize ik @@ Some (x *: c, Z.gcd (x *: m) ((c *: x) *: (m' +: Z.one))) - else *) - normalize ik @@ Some (x *: c, Z.gcd (x *: m) (c *: x)) - - let shift_left ik x y = - let res = shift_left ik x y in - if M.tracing then M.trace "congruence" "shift_left : %a %a becomes %a " pretty x pretty y pretty res; - res - - (* Handle unsigned overflows. - From n === k mod (2^a * b), we conclude n === k mod 2^a, for a <= bitwidth. - The congruence modulo b may not persist on an overflow. *) - let handle_overflow ik (c, m) = - if m =: Z.zero then - normalize ik (Some (c, m)) - else - (* Find largest m'=2^k (for some k) such that m is divisible by m' *) - let tz = Z.trailing_zeros m in - let m' = Z.shift_left Z.one tz in - - let max = (snd (Size.range ik)) +: Z.one in - if m' >=: max then - (* if m' >= 2 ^ {bitlength}, there is only one value in range *) - let c' = c %: max in - Some (c', Z.zero) - else - normalize ik (Some (c, m')) - - let mul ?(no_ov=false) ik x y = - let no_ov_case (c1, m1) (c2, m2) = - c1 *: c2, Z.gcd (c1 *: m2) (Z.gcd (m1 *: c2) (m1 *: m2)) - in - match x, y with - | None, None -> bot () - | None, _ | _, None -> - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c1, m1), Some (c2, m2) when no_ov -> - Some (no_ov_case (c1, m1) (c2, m2)) - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero && m2 =: Z.zero && not (Cil.isSigned ik) -> - let (_, max_ik) = range ik in - Some ((c1 *: c2) %: (max_ik +: Z.one), Z.zero) - | Some a, Some b when not (Cil.isSigned ik) -> - handle_overflow ik (no_ov_case a b ) - | _ -> top () - - let mul ?no_ov ik x y = - let res = mul ?no_ov ik x y in - if M.tracing then M.trace "congruence" "mul : %a %a -> %a " pretty x pretty y pretty res; - res - - let neg ?(no_ov=false) ik x = - match x with - | None -> bot() - | Some _ -> mul ~no_ov ik (of_int ik (Z.of_int (-1))) x - - let add ?(no_ov=false) ik x y = - let no_ov_case (c1, m1) (c2, m2) = - c1 +: c2, Z.gcd m1 m2 - in - match (x, y) with - | None, None -> bot () - | None, _ | _, None -> - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some a, Some b when no_ov -> - normalize ik (Some (no_ov_case a b)) - | Some (c1, m1), Some (c2, m2) when m1 =: Z.zero && m2 =: Z.zero && not (Cil.isSigned ik) -> - let (_, max_ik) = range ik in - Some((c1 +: c2) %: (max_ik +: Z.one), Z.zero) - | Some a, Some b when not (Cil.isSigned ik) -> - handle_overflow ik (no_ov_case a b) - | _ -> top () - - - let add ?no_ov ik x y = - let res = add ?no_ov ik x y in - if M.tracing then - M.trace "congruence" "add : %a %a -> %a" pretty x pretty y - pretty res ; - res - - let sub ?(no_ov=false) ik x y = add ~no_ov ik x (neg ~no_ov ik y) - - - let sub ?no_ov ik x y = - let res = sub ?no_ov ik x y in - if M.tracing then - M.trace "congruence" "sub : %a %a -> %a" pretty x pretty y - pretty res ; - res - - let lognot ik x = match x with - | None -> None - | Some (c, m) -> - if (Cil.isSigned ik) then - sub ik (neg ik x) one - else - let (_, max_ik) = range ik in - Some (Z.sub max_ik c, m) - - (** The implementation of the bit operations could be improved based on the master’s thesis - 'Abstract Interpretation and Abstract Domains' written by Stefan Bygde. - see: http://www.es.mdh.se/pdf_publications/948.pdf *) - let bit2 f ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c, m), Some (c', m') -> - if m =: Z.zero && m' =: Z.zero then Some (f c c', Z.zero) - else top () - - let logor ik x y = bit2 Z.logor ik x y - - let logand ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c, m), Some (c', m') -> - if m =: Z.zero && m' =: Z.zero then - (* both arguments constant *) - Some (Z.logand c c', Z.zero) - else if m' =: Z.zero && c' =: Z.one && Z.rem m (Z.of_int 2) =: Z.zero then - (* x & 1 and x == c (mod 2*z) *) - (* Value is equal to LSB of c *) - Some (Z.logand c c', Z.zero) - else - top () - - let logxor ik x y = bit2 Z.logxor ik x y - - let rem ik x y = - match x, y with - | None, None -> bot() - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c1, m1), Some(c2, m2) -> - if m2 =: Z.zero then - if (c2 |: m1) && (c1 %: c2 =: Z.zero || m1 =: Z.zero || not (Cil.isSigned ik)) then - Some (c1 %: c2, Z.zero) - else - normalize ik (Some (c1, (Z.gcd m1 c2))) - else - normalize ik (Some (c1, Z.gcd m1 (Z.gcd c2 m2))) - - let rem ik x y = let res = rem ik x y in - if M.tracing then M.trace "congruence" "rem : %a %a -> %a " pretty x pretty y pretty res; - res - - let div ?(no_ov=false) ik x y = - match x,y with - | None, None -> bot () - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, x when leq zero x -> top () - | Some(c1, m1), Some(c2, m2) when not no_ov && m2 =: Z.zero && c2 =: Z.neg Z.one -> top () - | Some(c1, m1), Some(c2, m2) when m1 =: Z.zero && m2 =: Z.zero -> Some (c1 /: c2, Z.zero) - | Some(c1, m1), Some(c2, m2) when m2 =: Z.zero && c2 |: m1 && c2 |: c1 -> Some (c1 /: c2, m1 /: c2) - | _, _ -> top () - - - let div ?no_ov ik x y = - let res = div ?no_ov ik x y in - if M.tracing then - M.trace "congruence" "div : %a %a -> %a" pretty x pretty y pretty - res ; - res - - let ne ik (x: t) (y: t) = match x, y with - | Some (c1, m1), Some (c2, m2) when (m1 =: Z.zero) && (m2 =: Z.zero) -> of_bool ik (not (c1 =: c2 )) - | x, y -> if meet ik x y = None then of_bool ik true else top_bool - - let eq ik (x: t) (y: t) = match x, y with - | Some (c1, m1), Some (c2, m2) when (m1 =: Z.zero) && (m2 =: Z.zero) -> of_bool ik (c1 =: c2) - | x, y -> if meet ik x y <> None then top_bool else of_bool ik false - - let comparison ik op x y = match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (c1, m1), Some (c2, m2) -> - if m1 =: Z.zero && m2 =: Z.zero then - if op c1 c2 then of_bool ik true else of_bool ik false - else - top_bool - - let ge ik x y = comparison ik (>=:) x y - - let ge ik x y = - let res = ge ik x y in - if M.tracing then M.trace "congruence" "greater or equal : %a %a -> %a " pretty x pretty y pretty res; - res - - let le ik x y = comparison ik (<=:) x y - - let le ik x y = - let res = le ik x y in - if M.tracing then M.trace "congruence" "less or equal : %a %a -> %a " pretty x pretty y pretty res; - res - - let gt ik x y = comparison ik (>:) x y - - - let gt ik x y = - let res = gt ik x y in - if M.tracing then M.trace "congruence" "greater than : %a %a -> %a " pretty x pretty y pretty res; - res - - let lt ik x y = comparison ik (<:) x y - - let lt ik x y = - let res = lt ik x y in - if M.tracing then M.trace "congruence" "less than : %a %a -> %a " pretty x pretty y pretty res; - res - - let invariant_ikind e ik x = - match x with - | x when is_top x -> Invariant.top () - | Some (c, m) when m =: Z.zero -> - IntInvariant.of_int e ik c - | Some (c, m) -> - let open Cil in - let (c, m) = BatTuple.Tuple2.mapn (fun a -> kintegerCilint ik a) (c, m) in - Invariant.of_exp (BinOp (Eq, (BinOp (Mod, e, m, TInt(ik,[]))), c, intType)) - | None -> Invariant.none - - let arbitrary ik = - let open QCheck in - let int_arb = map ~rev:Z.to_int64 Z.of_int64 GobQCheck.Arbitrary.int64 in - let cong_arb = pair int_arb int_arb in - let of_pair ik p = normalize ik (Some p) in - let to_pair = Option.get in - set_print show (map ~rev:to_pair (of_pair ik) cong_arb) - - let refine_with_interval ik (cong : t) (intv : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if m =: Z.zero then - if c <: x || c >: y then None else Some (c, Z.zero) - else - let rcx = x +: ((c -: x) %: Z.abs m) in - let lcy = y -: ((y -: c) %: Z.abs m) in - if rcx >: lcy then None - else if rcx =: lcy then Some (rcx, Z.zero) - else cong - | _ -> None - - let refine_with_interval ik (cong : t) (intv : (int_t * int_t) option) : t = - let pretty_intv _ i = - match i with - | Some (l, u) -> Pretty.dprintf "[%a,%a]" GobZ.pretty l GobZ.pretty u - | _ -> Pretty.text ("Display Error") in - let refn = refine_with_interval ik cong intv in - if M.tracing then M.trace "refine" "cong_refine_with_interval %a %a -> %a" pretty cong pretty_intv intv pretty refn; - refn - - let refine_with_congruence ik a b = meet ik a b - let refine_with_excl_list ik a b = a - let refine_with_incl_list ik a b = a - - let project ik p t = t -end - module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct include D From f5c1a1cf049a983f15384568a16dd55625340ec8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 16:59:38 +0300 Subject: [PATCH 105/157] Rename IntDomain0 -> EnumsDomain for split --- src/cdomain/value/cdomains/{intDomain0.ml => int/enumsDomain.ml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/cdomain/value/cdomains/{intDomain0.ml => int/enumsDomain.ml} (100%) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/int/enumsDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/intDomain0.ml rename to src/cdomain/value/cdomains/int/enumsDomain.ml From 92ec19e4007986f1d48b2da79d42456cda83fe95 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:00:03 +0300 Subject: [PATCH 106/157] Remove non-EnumsDomain parts --- src/cdomain/value/cdomains/int/enumsDomain.ml | 2409 +---------------- 1 file changed, 1 insertion(+), 2408 deletions(-) diff --git a/src/cdomain/value/cdomains/int/enumsDomain.ml b/src/cdomain/value/cdomains/int/enumsDomain.ml index 8dd8b07f74..d0208feeff 100644 --- a/src/cdomain/value/cdomains/int/enumsDomain.ml +++ b/src/cdomain/value/cdomains/int/enumsDomain.ml @@ -1,2380 +1,5 @@ -open GobConfig -open GoblintCil -open Pretty -open PrecisionUtil +open IntDomain0 -module M = Messages - -let (%) = Batteries.(%) -let (|?) = Batteries.(|?) - -exception IncompatibleIKinds of string -exception Unknown -exception Error -exception ArithmeticOnIntegerBot of string - - - - -(** Define records that hold mutable variables representing different Configuration values. - * These values are used to keep track of whether or not the corresponding Config values are en-/disabled *) -type ana_int_config_values = { - mutable interval_threshold_widening : bool option; - mutable interval_narrow_by_meet : bool option; - mutable def_exc_widen_by_join : bool option; - mutable interval_threshold_widening_constants : string option; - mutable refinement : string option; -} - -let ana_int_config: ana_int_config_values = { - interval_threshold_widening = None; - interval_narrow_by_meet = None; - def_exc_widen_by_join = None; - interval_threshold_widening_constants = None; - refinement = None; -} - -let get_interval_threshold_widening () = - if ana_int_config.interval_threshold_widening = None then - ana_int_config.interval_threshold_widening <- Some (get_bool "ana.int.interval_threshold_widening"); - Option.get ana_int_config.interval_threshold_widening - -let get_interval_narrow_by_meet () = - if ana_int_config.interval_narrow_by_meet = None then - ana_int_config.interval_narrow_by_meet <- Some (get_bool "ana.int.interval_narrow_by_meet"); - Option.get ana_int_config.interval_narrow_by_meet - -let get_def_exc_widen_by_join () = - if ana_int_config.def_exc_widen_by_join = None then - ana_int_config.def_exc_widen_by_join <- Some (get_bool "ana.int.def_exc_widen_by_join"); - Option.get ana_int_config.def_exc_widen_by_join - -let get_interval_threshold_widening_constants () = - if ana_int_config.interval_threshold_widening_constants = None then - ana_int_config.interval_threshold_widening_constants <- Some (get_string "ana.int.interval_threshold_widening_constants"); - Option.get ana_int_config.interval_threshold_widening_constants - -let get_refinement () = - if ana_int_config.refinement = None then - ana_int_config.refinement <- Some (get_string "ana.int.refinement"); - Option.get ana_int_config.refinement - - - -(** Whether for a given ikind, we should compute with wrap-around arithmetic. - * Always for unsigned types, for signed types if 'sem.int.signed_overflow' is 'assume_wraparound' *) -let should_wrap ik = not (Cil.isSigned ik) || get_string "sem.int.signed_overflow" = "assume_wraparound" - -(** Whether for a given ikind, we should assume there are no overflows. - * Always false for unsigned types, true for signed types if 'sem.int.signed_overflow' is 'assume_none' *) -let should_ignore_overflow ik = Cil.isSigned ik && get_string "sem.int.signed_overflow" = "assume_none" - -let widening_thresholds = ResettableLazy.from_fun WideningThresholds.thresholds -let widening_thresholds_desc = ResettableLazy.from_fun (List.rev % WideningThresholds.thresholds) - -type overflow_info = { overflow: bool; underflow: bool;} - -let set_overflow_flag ~cast ~underflow ~overflow ik = - if !AnalysisState.executing_speculative_computations then - (* Do not produce warnings when the operations are not actually happening in code *) - () - else - let signed = Cil.isSigned ik in - if !AnalysisState.postsolving && signed && not cast then - AnalysisState.svcomp_may_overflow := true; - let sign = if signed then "Signed" else "Unsigned" in - match underflow, overflow with - | true, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190; CWE 191] "%s integer overflow and underflow" sign - | true, false -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 191] "%s integer underflow" sign - | false, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190] "%s integer overflow" sign - | false, false -> assert false - -let reset_lazy () = - ResettableLazy.reset widening_thresholds; - ResettableLazy.reset widening_thresholds_desc; - ana_int_config.interval_threshold_widening <- None; - ana_int_config.interval_narrow_by_meet <- None; - ana_int_config.def_exc_widen_by_join <- None; - ana_int_config.interval_threshold_widening_constants <- None; - ana_int_config.refinement <- None - -module type Arith = -sig - type t - val neg: t -> t - val add: t -> t -> t - val sub: t -> t -> t - val mul: t -> t -> t - val div: t -> t -> t - val rem: t -> t -> t - - val lt: t -> t -> t - val gt: t -> t -> t - val le: t -> t -> t - val ge: t -> t -> t - val eq: t -> t -> t - val ne: t -> t -> t - - val lognot: t -> t - val logand: t -> t -> t - val logor : t -> t -> t - val logxor: t -> t -> t - - val shift_left : t -> t -> t - val shift_right: t -> t -> t - - val c_lognot: t -> t - val c_logand: t -> t -> t - val c_logor : t -> t -> t - -end - -module type ArithIkind = -sig - type t - val neg: Cil.ikind -> t -> t - val add: Cil.ikind -> t -> t -> t - val sub: Cil.ikind -> t -> t -> t - val mul: Cil.ikind -> t -> t -> t - val div: Cil.ikind -> t -> t -> t - val rem: Cil.ikind -> t -> t -> t - - val lt: Cil.ikind -> t -> t -> t - val gt: Cil.ikind -> t -> t -> t - val le: Cil.ikind -> t -> t -> t - val ge: Cil.ikind -> t -> t -> t - val eq: Cil.ikind -> t -> t -> t - val ne: Cil.ikind -> t -> t -> t - - val lognot: Cil.ikind -> t -> t - val logand: Cil.ikind -> t -> t -> t - val logor : Cil.ikind -> t -> t -> t - val logxor: Cil.ikind -> t -> t -> t - - val shift_left : Cil.ikind -> t -> t -> t - val shift_right: Cil.ikind -> t -> t -> t - - val c_lognot: Cil.ikind -> t -> t - val c_logand: Cil.ikind -> t -> t -> t - val c_logor : Cil.ikind -> t -> t -> t - -end - -(* Shared functions between S and Z *) -module type B = -sig - include Lattice.S - type int_t - val bot_of: Cil.ikind -> t - val top_of: Cil.ikind -> t - val to_int: t -> int_t option - val equal_to: int_t -> t -> [`Eq | `Neq | `Top] - - val to_bool: t -> bool option - val to_excl_list: t -> (int_t list * (int64 * int64)) option - val of_excl_list: Cil.ikind -> int_t list -> t - val is_excl_list: t -> bool - - val to_incl_list: t -> int_t list option - - val maximal : t -> int_t option - val minimal : t -> int_t option - - val cast_to: ?suppress_ovwarn:bool -> ?torg:Cil.typ -> Cil.ikind -> t -> t -end - -(** Interface of IntDomain implementations that do not take ikinds for arithmetic operations yet. TODO: Should be ported to S in the future. *) -module type IkindUnawareS = -sig - include B - include Arith with type t := t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: int_t -> t - val of_bool: bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val arbitrary: unit -> t QCheck.arbitrary - val invariant: Cil.exp -> t -> Invariant.t -end - -(** Interface of IntDomain implementations taking an ikind for arithmetic operations *) -module type S = -sig - include B - include ArithIkind with type t:= t - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val neg : ?no_ov:bool -> Cil.ikind -> t -> t - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t - - val join: Cil.ikind -> t -> t -> t - val meet: Cil.ikind -> t -> t -> t - val narrow: Cil.ikind -> t -> t -> t - val widen: Cil.ikind -> t -> t -> t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val is_top_of: Cil.ikind -> t -> bool - val invariant_ikind : Cil.exp -> Cil.ikind -> t -> Invariant.t - - val refine_with_congruence: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_interval: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_excl_list: Cil.ikind -> t -> (int_t list * (int64 * int64)) option -> t - val refine_with_incl_list: Cil.ikind -> t -> int_t list option -> t - - val project: Cil.ikind -> int_precision -> t -> t - val arbitrary: Cil.ikind -> t QCheck.arbitrary -end - -module type SOverflow = -sig - - include S - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val neg : ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val of_int : Cil.ikind -> int_t -> t * overflow_info - - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t * overflow_info - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - - val shift_left : Cil.ikind -> t -> t -> t * overflow_info - - val shift_right : Cil.ikind -> t -> t -> t * overflow_info -end - -module type Y = -sig - (* include B *) - include B - include Arith with type t:= t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val is_top_of: Cil.ikind -> t -> bool - - val project: int_precision -> t -> t - val invariant: Cil.exp -> t -> Invariant.t -end - -module type Z = Y with type int_t = Z.t - - -module IntDomLifter (I : S) = -struct - open Cil - type int_t = I.int_t - type t = { v : I.t; ikind : CilType.Ikind.t } [@@deriving eq, ord, hash] - - let ikind {ikind; _} = ikind - - (* Helper functions *) - let check_ikinds x y = if x.ikind <> y.ikind then raise (IncompatibleIKinds (GobPretty.sprintf "ikinds %a and %a are incompatible. Values: %a and %a" CilType.Ikind.pretty x.ikind CilType.Ikind.pretty y.ikind I.pretty x.v I.pretty y.v)) - let lift op x = {x with v = op x.ikind x.v } - (* For logical operations the result is of type int *) - let lift_logical op x = {v = op x.ikind x.v; ikind = Cil.IInt} - let lift2 op x y = check_ikinds x y; {x with v = op x.ikind x.v y.v } - let lift2_cmp op x y = check_ikinds x y; {v = op x.ikind x.v y.v; ikind = Cil.IInt} - - let bot_of ikind = { v = I.bot_of ikind; ikind} - let bot () = failwith "bot () is not implemented for IntDomLifter." - let is_bot x = I.is_bot x.v - let top_of ikind = { v = I.top_of ikind; ikind} - let top () = failwith "top () is not implemented for IntDomLifter." - let is_top x = I.is_top x.v - - (* Leq does not check for ikind, because it is used in invariant with arguments of different type. - TODO: check ikinds here and fix invariant to work with right ikinds *) - let leq x y = I.leq x.v y.v - let join = lift2 I.join - let meet = lift2 I.meet - let widen = lift2 I.widen - let narrow = lift2 I.narrow - - let show x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - "⊤" - else - I.show x.v (* TODO add ikind to output *) - let pretty () x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - Pretty.text "⊤" - else - I.pretty () x.v (* TODO add ikind to output *) - let pretty_diff () (x, y) = I.pretty_diff () (x.v, y.v) (* TODO check ikinds, add them to output *) - let printXml o x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - BatPrintf.fprintf o "\n\n⊤\n\n\n" - else - I.printXml o x.v (* TODO add ikind to output *) - (* This is for debugging *) - let name () = "IntDomLifter(" ^ (I.name ()) ^ ")" - let to_yojson x = I.to_yojson x.v - let invariant e x = - let e' = Cilfacade.mkCast ~e ~newt:(TInt (x.ikind, [])) in - I.invariant_ikind e' x.ikind x.v - let tag x = I.tag x.v - let arbitrary ik = failwith @@ "Arbitrary not implement for " ^ (name ()) ^ "." - let to_int x = I.to_int x.v - let of_int ikind x = { v = I.of_int ikind x; ikind} - let equal_to i x = I.equal_to i x.v - let to_bool x = I.to_bool x.v - let of_bool ikind b = { v = I.of_bool ikind b; ikind} - let to_excl_list x = I.to_excl_list x.v - let of_excl_list ikind is = {v = I.of_excl_list ikind is; ikind} - let is_excl_list x = I.is_excl_list x.v - let to_incl_list x = I.to_incl_list x.v - let of_interval ?(suppress_ovwarn=false) ikind (lb,ub) = {v = I.of_interval ~suppress_ovwarn ikind (lb,ub); ikind} - let of_congruence ikind (c,m) = {v = I.of_congruence ikind (c,m); ikind} - let starting ?(suppress_ovwarn=false) ikind i = {v = I.starting ~suppress_ovwarn ikind i; ikind} - let ending ?(suppress_ovwarn=false) ikind i = {v = I.ending ~suppress_ovwarn ikind i; ikind} - let maximal x = I.maximal x.v - let minimal x = I.minimal x.v - - let neg = lift I.neg - let add = lift2 I.add - let sub = lift2 I.sub - let mul = lift2 I.mul - let div = lift2 I.div - let rem = lift2 I.rem - let lt = lift2_cmp I.lt - let gt = lift2_cmp I.gt - let le = lift2_cmp I.le - let ge = lift2_cmp I.ge - let eq = lift2_cmp I.eq - let ne = lift2_cmp I.ne - let lognot = lift I.lognot - let logand = lift2 I.logand - let logor = lift2 I.logor - let logxor = lift2 I.logxor - let shift_left x y = {x with v = I.shift_left x.ikind x.v y.v } (* TODO check ikinds*) - let shift_right x y = {x with v = I.shift_right x.ikind x.v y.v } (* TODO check ikinds*) - let c_lognot = lift_logical I.c_lognot - let c_logand = lift2 I.c_logand - let c_logor = lift2 I.c_logor - - let cast_to ?(suppress_ovwarn=false) ?torg ikind x = {v = I.cast_to ~suppress_ovwarn ~torg:(TInt(x.ikind,[])) ikind x.v; ikind} - - let is_top_of ik x = ik = x.ikind && I.is_top_of ik x.v - - let relift x = { v = I.relift x.v; ikind = x.ikind } - - let project p v = { v = I.project v.ikind p v.v; ikind = v.ikind } -end - -module type Ikind = -sig - val ikind: unit -> Cil.ikind -end - -module PtrDiffIkind : Ikind = -struct - let ikind = Cilfacade.ptrdiff_ikind -end - -module IntDomWithDefaultIkind (I: Y) (Ik: Ikind) : Y with type t = I.t and type int_t = I.int_t = -struct - include I - let top () = I.top_of (Ik.ikind ()) - let bot () = I.bot_of (Ik.ikind ()) -end - -module Size = struct (* size in bits as int, range as int64 *) - open Cil - let sign x = if Z.compare x Z.zero < 0 then `Signed else `Unsigned - - let top_typ = TInt (ILongLong, []) - let min_for x = intKindForValue x (sign x = `Unsigned) - let bit = function (* bits needed for representation *) - | IBool -> 1 - | ik -> bytesSizeOfInt ik * 8 - let is_int64_big_int x = Z.fits_int64 x - let card ik = (* cardinality *) - let b = bit ik in - Z.shift_left Z.one b - let bits ik = (* highest bits for neg/pos values *) - let s = bit ik in - if isSigned ik then s-1, s-1 else 0, s - let bits_i64 ik = BatTuple.Tuple2.mapn Int64.of_int (bits ik) - let range ik = - let a,b = bits ik in - let x = if isSigned ik then Z.neg (Z.shift_left Z.one a) (* -2^a *) else Z.zero in - let y = Z.pred (Z.shift_left Z.one b) in (* 2^b - 1 *) - x,y - - let is_cast_injective ~from_type ~to_type = - let (from_min, from_max) = range (Cilfacade.get_ikind from_type) in - let (to_min, to_max) = range (Cilfacade.get_ikind to_type) in - if M.tracing then M.trace "int" "is_cast_injective %a (%a, %a) -> %a (%a, %a)" CilType.Typ.pretty from_type GobZ.pretty from_min GobZ.pretty from_max CilType.Typ.pretty to_type GobZ.pretty to_min GobZ.pretty to_max; - Z.compare to_min from_min <= 0 && Z.compare from_max to_max <= 0 - - let cast t x = (* TODO: overflow is implementation-dependent! *) - if t = IBool then - (* C11 6.3.1.2 Boolean type *) - if Z.equal x Z.zero then Z.zero else Z.one - else - let a,b = range t in - let c = card t in - let y = Z.erem x c in - let y = if Z.gt y b then Z.sub y c - else if Z.lt y a then Z.add y c - else y - in - if M.tracing then M.tracel "cast" "Cast %a to range [%a, %a] (%a) = %a (%s in int64)" GobZ.pretty x GobZ.pretty a GobZ.pretty b GobZ.pretty c GobZ.pretty y (if is_int64_big_int y then "fits" else "does not fit"); - y - - let min_range_sign_agnostic x = - let size ik = - let a,b = bits_i64 ik in - Int64.neg a,b - in - if sign x = `Signed then - size (min_for x) - else - let a, b = size (min_for x) in - if b <= 64L then - let upper_bound_less = Int64.sub b 1L in - let max_one_less = Z.(pred @@ shift_left Z.one (Int64.to_int upper_bound_less)) in - if x <= max_one_less then - a, upper_bound_less - else - a,b - else - a, b - - (* From the number of bits used to represent a positive value, determines the maximal representable value *) - let max_from_bit_range pos_bits = Z.(pred @@ shift_left Z.one (to_int (Z.of_int64 pos_bits))) - - (* From the number of bits used to represent a non-positive value, determines the minimal representable value *) - let min_from_bit_range neg_bits = Z.(if neg_bits = 0L then Z.zero else neg @@ shift_left Z.one (to_int (neg (Z.of_int64 neg_bits)))) - -end - - -module StdTop (B: sig type t val top_of: Cil.ikind -> t end) = struct - open B - (* these should be overwritten for better precision if possible: *) - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ik x = top_of ik - let ending ?(suppress_ovwarn=false) ik x = top_of ik - let maximal x = None - let minimal x = None -end - -module Std (B: sig - type t - val name: unit -> string - val top_of: Cil.ikind -> t - val bot_of: Cil.ikind -> t - val show: t -> string - val equal: t -> t -> bool - end) = struct - include Printable.StdLeaf - let name = B.name (* overwrite the one from Printable.Std *) - open B - let is_top x = failwith "is_top not implemented for IntDomain.Std" - let is_bot x = B.equal x (bot_of Cil.IInt) (* Here we assume that the representation of bottom is independent of the ikind - This may be true for intdomain implementations, but not e.g. for IntDomLifter. *) - let is_top_of ik x = B.equal x (top_of ik) - - (* all output is based on B.show *) - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - let pretty_diff () (x,y) = dprintf "%s: %a instead of %a" (name ()) pretty x pretty y - - include StdTop (B) -end - -(* Textbook interval arithmetic, without any overflow handling etc. *) -module IntervalArith (Ints_t : IntOps.IntOps) = struct - let min4 a b c d = Ints_t.min (Ints_t.min a b) (Ints_t.min c d) - let max4 a b c d = Ints_t.max (Ints_t.max a b) (Ints_t.max c d) - - let mul (x1, x2) (y1, y2) = - let x1y1 = (Ints_t.mul x1 y1) in - let x1y2 = (Ints_t.mul x1 y2) in - let x2y1 = (Ints_t.mul x2 y1) in - let x2y2 = (Ints_t.mul x2 y2) in - (min4 x1y1 x1y2 x2y1 x2y2, max4 x1y1 x1y2 x2y1 x2y2) - - let shift_left (x1,x2) (y1,y2) = - let y1p = Ints_t.shift_left Ints_t.one y1 in - let y2p = Ints_t.shift_left Ints_t.one y2 in - mul (x1, x2) (y1p, y2p) - - let div (x1, x2) (y1, y2) = - let x1y1n = (Ints_t.div x1 y1) in - let x1y2n = (Ints_t.div x1 y2) in - let x2y1n = (Ints_t.div x2 y1) in - let x2y2n = (Ints_t.div x2 y2) in - let x1y1p = (Ints_t.div x1 y1) in - let x1y2p = (Ints_t.div x1 y2) in - let x2y1p = (Ints_t.div x2 y1) in - let x2y2p = (Ints_t.div x2 y2) in - (min4 x1y1n x1y2n x2y1n x2y2n, max4 x1y1p x1y2p x2y1p x2y2p) - - let add (x1, x2) (y1, y2) = (Ints_t.add x1 y1, Ints_t.add x2 y2) - let sub (x1, x2) (y1, y2) = (Ints_t.sub x1 y2, Ints_t.sub x2 y1) - - let neg (x1, x2) = (Ints_t.neg x2, Ints_t.neg x1) - - let one = (Ints_t.one, Ints_t.one) - let zero = (Ints_t.zero, Ints_t.zero) - let top_bool = (Ints_t.zero, Ints_t.one) - - let to_int (x1, x2) = - if Ints_t.equal x1 x2 then Some x1 else None - - let upper_threshold u max_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - let max_ik' = Ints_t.to_bigint max_ik in - let t = List.find_opt (fun x -> Z.compare u x <= 0 && Z.compare x max_ik' <= 0) ts in - BatOption.map_default Ints_t.of_bigint max_ik t - let lower_threshold l min_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - let min_ik' = Ints_t.to_bigint min_ik in - let t = List.find_opt (fun x -> Z.compare l x >= 0 && Z.compare x min_ik' >= 0) ts in - BatOption.map_default Ints_t.of_bigint min_ik t - let is_upper_threshold u = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - List.exists (Z.equal u) ts - let is_lower_threshold l = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - List.exists (Z.equal l) ts -end - -module IntInvariant = -struct - let of_int e ik x = - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.none - - let of_incl_list e ik ps = - match ps with - | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> - assert (List.mem Z.zero ps); - assert (List.mem Z.one ps); - Invariant.none - | [_] when get_bool "witness.invariant.exact" -> - Invariant.none - | _ :: _ :: _ - | [_] | [] -> - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ps - - let of_interval_opt e ik = function - | (Some x1, Some x2) when Z.equal x1 x2 -> - of_int e ik x1 - | x1_opt, x2_opt -> - let (min_ik, max_ik) = Size.range ik in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = - match x1_opt, inexact_type_bounds with - | Some x1, false when Z.equal min_ik x1 -> Invariant.none - | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) - | None, _ -> Invariant.none - in - let i2 = - match x2_opt, inexact_type_bounds with - | Some x2, false when Z.equal x2 max_ik -> Invariant.none - | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) - | None, _ -> Invariant.none - in - Invariant.(i1 && i2) - - let of_interval e ik (x1, x2) = - of_interval_opt e ik (Some x1, Some x2) - - let of_excl_list e ik ns = - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) (Invariant.top ()) ns -end - -module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = -struct - let name () = "intervals" - type int_t = Ints_t.t - type t = (Ints_t.t * Ints_t.t) option [@@deriving eq, ord, hash] - module IArith = IntervalArith (Ints_t) - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - let top_of ik = Some (range ik) - let bot () = None - let bot_of ik = bot () (* TODO: improve *) - - let show = function None -> "bottom" | Some (x,y) -> "["^Ints_t.to_string x^","^Ints_t.to_string y^"]" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) -> - if a = b && b = i then `Eq else if Ints_t.compare a i <= 0 && Ints_t.compare i b <=0 then `Top else `Neq - - let norm ?(suppress_ovwarn=false) ?(cast=false) ik : (t -> t * overflow_info) = function None -> (None, {underflow=false; overflow=false}) | Some (x,y) -> - if Ints_t.compare x y > 0 then - (None,{underflow=false; overflow=false}) - else ( - let (min_ik, max_ik) = range ik in - let underflow = Ints_t.compare min_ik x > 0 in - let overflow = Ints_t.compare max_ik y < 0 in - let ov_info = { underflow = underflow && not suppress_ovwarn; overflow = overflow && not suppress_ovwarn } in - let v = - if underflow || overflow then - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (Ints_t.sub max_ik min_ik) in - let resdiff = Ints_t.abs (Ints_t.sub y x) in - if Ints_t.compare resdiff diff > 0 then - top_of ik - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if Ints_t.compare l u <= 0 then - Some (l, u) - else - (* Interval that wraps around (begins to the right of its end). We can not represent such intervals *) - top_of ik - else if not cast && should_ignore_overflow ik then - let tl, tu = BatOption.get @@ top_of ik in - Some (Ints_t.max tl x, Ints_t.min tu y) - else - top_of ik - else - Some (x,y) - in - (v, ov_info) - ) - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (x1,x2), Some (y1,y2) -> Ints_t.compare x1 y1 >= 0 && Ints_t.compare x2 y2 <= 0 - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.min x1 y1, Ints_t.max x2 y2) |> fst - - let meet ik (x:t) y = - match x, y with - | None, z | z, None -> None - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.max x1 y1, Ints_t.min x2 y2) |> fst - - (* TODO: change to_int signature so it returns a big_int *) - let to_int x = Option.bind x (IArith.to_int) - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm ~suppress_ovwarn ik @@ Some (x,y) - let of_int ik (x: int_t) = of_interval ik (x,x) - let zero = Some IArith.zero - let one = Some IArith.one - let top_bool = Some IArith.top_bool - - let of_bool _ik = function true -> one | false -> zero - let to_bool (a: t) = match a with - | None -> None - | Some (l, u) when Ints_t.compare l Ints_t.zero = 0 && Ints_t.compare u Ints_t.zero = 0 -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (fst (range ik), n) - - (* TODO: change signature of maximal, minimal to return big_int*) - let maximal = function None -> None | Some (x,y) -> Some y - let minimal = function None -> None | Some (x,y) -> Some x - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov t = norm ~cast:true t (* norm does all overflow handling *) - - let widen ik x y = - match x, y with - | None, z | z, None -> z - | Some (l0,u0), Some (l1,u1) -> - let (min_ik, max_ik) = range ik in - let threshold = get_interval_threshold_widening () in - let l2 = - if Ints_t.compare l0 l1 = 0 then l0 - else if threshold then IArith.lower_threshold l1 min_ik - else min_ik - in - let u2 = - if Ints_t.compare u0 u1 = 0 then u0 - else if threshold then IArith.upper_threshold u1 max_ik - else max_ik - in - norm ik @@ Some (l2,u2) |> fst - let widen ik x y = - let r = widen ik x y in - if M.tracing && not (equal x y) then M.tracel "int" "interval widen %a %a -> %a" pretty x pretty y pretty r; - assert (leq x y); (* TODO: remove for performance reasons? *) - r - - let narrow ik x y = - match x, y with - | _,None | None, _ -> None - | Some (x1,x2), Some (y1,y2) -> - let threshold = get_interval_threshold_widening () in - let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 || threshold && Ints_t.compare y1 x1 > 0 && IArith.is_lower_threshold x1 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 || threshold && Ints_t.compare y2 x2 < 0 && IArith.is_upper_threshold x2 then y2 else x2 in - norm ik @@ Some (lr,ur) |> fst - - - let narrow ik x y = - if get_interval_narrow_by_meet () then - meet ik x y - else - narrow ik x y - - let log f ~annihilator ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, _ when x = annihilator -> of_bool ik annihilator - | _, Some y when y = annihilator -> of_bool ik annihilator - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) ~annihilator:true - let c_logand = log (&&) ~annihilator:false - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let bit f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - let bitcomp f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{underflow=false; overflow=false})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let logxor = bit (fun _ik -> Ints_t.logxor) - - let logand ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (Ints_t.logand x y) |> fst with Division_by_zero -> top_of ik) - | _, Some y when Ints_t.equal y Ints_t.zero -> of_int ik Ints_t.zero |> fst - | _, Some y when Ints_t.equal y Ints_t.one -> of_interval ik (Ints_t.zero, Ints_t.one) |> fst - | _ -> top_of ik - - let logor = bit (fun _ik -> Ints_t.logor) - - let bit1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_int i1 with - | Some x -> of_int ik (f ik x) |> fst - | _ -> top_of ik - - let lognot = bit1 (fun _ik -> Ints_t.lognot) - let shift_right = bitcomp (fun _ik x y -> Ints_t.shift_right x (Ints_t.to_int y)) - - let neg ?no_ov ik = function None -> (None,{underflow=false; overflow=false}) | Some x -> norm ik @@ Some (IArith.neg x) - - let binary_op_with_norm ?no_ov op ik x y = match x, y with - | None, None -> (None, {overflow=false; underflow= false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some x, Some y -> norm ik @@ Some (op x y) - - let add ?no_ov = binary_op_with_norm IArith.add - let mul ?no_ov = binary_op_with_norm IArith.mul - let sub ?no_ov = binary_op_with_norm IArith.sub - - let shift_left ik a b = - match is_bot a, is_bot b with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show a) (show b))) - | _ -> - match a, minimal b, maximal b with - | Some a, Some bl, Some bu when (Ints_t.compare bl Ints_t.zero >= 0) -> - (try - let r = IArith.shift_left a (Ints_t.to_int bl, Ints_t.to_int bu) in - norm ik @@ Some r - with Z.Overflow -> (top_of ik,{underflow=false; overflow=true})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let rem ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (xl, xu), Some (yl, yu) -> - if is_top_of ik x && is_top_of ik y then - (* This is needed to preserve soundness also on things bigger than int32 e.g. *) - (* x: 3803957176L -> T in Interval32 *) - (* y: 4209861404L -> T in Interval32 *) - (* x % y: 3803957176L -> T in Interval32 *) - (* T in Interval32 is [-2147483648,2147483647] *) - (* the code below computes [-2147483647,2147483647] for this though which is unsound *) - top_of ik - else - (* If we have definite values, Ints_t.rem will give a definite result. - * Otherwise we meet with a [range] the result can be in. - * This range is [0, min xu b] if x is positive, and [max xl -b, min xu b] if x can be negative. - * The precise bound b is one smaller than the maximum bound. Negative y give the same result as positive. *) - let pos x = if Ints_t.compare x Ints_t.zero < 0 then Ints_t.neg x else x in - let b = Ints_t.sub (Ints_t.max (pos yl) (pos yu)) Ints_t.one in - let range = if Ints_t.compare xl Ints_t.zero>= 0 then Some (Ints_t.zero, Ints_t.min xu b) else Some (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit (fun _ik -> Ints_t.rem) ik x y) range - - let rec div ?no_ov ik x y = - match x, y with - | None, None -> (bot (),{underflow=false; overflow=false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | (Some (x1,x2) as x), (Some (y1,y2) as y) -> - begin - let is_zero v = Ints_t.compare v Ints_t.zero = 0 in - match y1, y2 with - | l, u when is_zero l && is_zero u -> (top_of ik,{underflow=false; overflow=false}) (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> div ik (Some (x1,x2)) (Some (Ints_t.one,y2)) - | _, u when is_zero u -> div ik (Some (x1,x2)) (Some (y1, Ints_t.(neg one))) - | _ when leq (of_int ik (Ints_t.zero) |> fst) (Some (y1,y2)) -> (top_of ik,{underflow=false; overflow=false}) - | _ -> binary_op_with_norm IArith.div ik x y - end - - let ne ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik true - else if Ints_t.compare x2 y1 <= 0 && Ints_t.compare y2 x1 <= 0 then - of_bool ik false - else top_bool - - let eq ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 && Ints_t.compare x2 y1 <= 0 then - of_bool ik true - else if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik false - else top_bool - - let ge ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 then of_bool ik true - else if Ints_t.compare x2 y1 < 0 then of_bool ik false - else top_bool - - let le ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 <= 0 then of_bool ik true - else if Ints_t.compare y2 x1 < 0 then of_bool ik false - else top_bool - - let gt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 then of_bool ik true - else if Ints_t.compare x2 y1 <= 0 then of_bool ik false - else top_bool - - let lt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 < 0 then of_bool ik true - else if Ints_t.compare y2 x1 <= 0 then of_bool ik false - else top_bool - - let invariant_ikind e ik = function - | Some (x1, x2) -> - let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in - IntInvariant.of_interval e ik (x1', x2') - | None -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let shrink = function - | Some (l, u) -> (return None) <+> (GobQCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) - | None -> empty - in - QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) (fun x -> of_interval ik x |> fst ) pair_arb) - - let modulo n k = - let result = Ints_t.rem n k in - if Ints_t.compare result Ints_t.zero >= 0 then result - else Ints_t.add result k - - let refine_with_congruence ik (intv : t) (cong : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if Ints_t.equal m Ints_t.zero && (Ints_t.compare c x < 0 || Ints_t.compare c y > 0) then None - else if Ints_t.equal m Ints_t.zero then - Some (c, c) - else - let (min_ik, max_ik) = range ik in - let rcx = - if Ints_t.equal x min_ik then x else - Ints_t.add x (modulo (Ints_t.sub c x) (Ints_t.abs m)) in - let lcy = - if Ints_t.equal y max_ik then y else - Ints_t.sub y (modulo (Ints_t.sub y c) (Ints_t.abs m)) in - if Ints_t.compare rcx lcy > 0 then None - else if Ints_t.equal rcx lcy then norm ik @@ Some (rcx, rcx) |> fst - else norm ik @@ Some (rcx, lcy) |> fst - | _ -> None - - let refine_with_congruence ik x y = - let refn = refine_with_congruence ik x y in - if M.tracing then M.trace "refine" "int_refine_with_congruence %a %a -> %a" pretty x pretty y pretty refn; - refn - - let refine_with_interval ik a b = meet ik a b - - let refine_with_excl_list ik (intv : t) (excl : (int_t list * (int64 * int64)) option) : t = - match intv, excl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls, (rl, rh)) -> - let rec shrink op b = - let new_b = (op b (Ints_t.of_int(Bool.to_int(BatList.mem_cmp Ints_t.compare b ls)))) in - if not (Ints_t.equal b new_b) then shrink op new_b else new_b - in - let (min_ik, max_ik) = range ik in - let l' = if Ints_t.equal l min_ik then l else shrink Ints_t.add l in - let u' = if Ints_t.equal u max_ik then u else shrink Ints_t.sub u in - let intv' = norm ik @@ Some (l', u') |> fst in - let range = norm ~suppress_ovwarn:true ik (Some (Ints_t.of_bigint (Size.min_from_bit_range rl), Ints_t.of_bigint (Size.max_from_bit_range rh))) |> fst in - meet ik intv' range - - let refine_with_incl_list ik (intv: t) (incl : (int_t list) option) : t = - match intv, incl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls) -> - let rec min m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> min (Some x) xs | Some m -> if Ints_t.compare m x < 0 then min (Some m) xs else min (Some x) xs in - let rec max m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> max (Some x) xs | Some m -> if Ints_t.compare m x > 0 then max (Some m) xs else max (Some x) xs in - match min None ls, max None ls with - | Some m1, Some m2 -> refine_with_interval ik (Some(l, u)) (Some (m1, m2)) - | _, _-> intv - - let project ik p t = t -end - -(** IntervalSetFunctor that is not just disjunctive completion of intervals, but attempts to be precise for wraparound arithmetic for unsigned types *) -module IntervalSetFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) list = -struct - - module Interval = IntervalFunctor (Ints_t) - module IArith = IntervalArith (Ints_t) - - - let name () = "interval_sets" - - type int_t = Ints_t.t - - let (>.) a b = Ints_t.compare a b > 0 - let (=.) a b = Ints_t.compare a b = 0 - let (<.) a b = Ints_t.compare a b < 0 - let (>=.) a b = Ints_t.compare a b >= 0 - let (<=.) a b = Ints_t.compare a b <= 0 - let (+.) a b = Ints_t.add a b - let (-.) a b = Ints_t.sub a b - - (* - Each domain's element is guaranteed to be in canonical form. That is, each interval contained - inside the set does not overlap with each other and they are not adjacent. - *) - type t = (Ints_t.t * Ints_t.t) list [@@deriving eq, hash, ord] - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - - let top_of ik = [range ik] - - let bot () = [] - - let bot_of ik = bot () - - let show (x: t) = - let show_interval i = Printf.sprintf "[%s, %s]" (Ints_t.to_string (fst i)) (Ints_t.to_string (snd i)) in - List.fold_left (fun acc i -> (show_interval i) :: acc) [] x |> List.rev |> String.concat ", " |> Printf.sprintf "[%s]" - - (* New type definition for the sweeping line algorithm used for implementing join/meet functions. *) - type event = Enter of Ints_t.t | Exit of Ints_t.t - - let unbox_event = function Enter x -> x | Exit x -> x - - let cmp_events x y = - (* Deliberately comparing ints first => Cannot be derived *) - let res = Ints_t.compare (unbox_event x) (unbox_event y) in - if res <> 0 then res - else - begin - match (x, y) with - | (Enter _, Exit _) -> -1 - | (Exit _, Enter _) -> 1 - | (_, _) -> 0 - end - - let interval_set_to_events (xs: t) = - List.concat_map (fun (a, b) -> [Enter a; Exit b]) xs - - let two_interval_sets_to_events (xs: t) (ys: t) = - let xs = interval_set_to_events xs in - let ys = interval_set_to_events ys in - List.merge cmp_events xs ys - - (* Using the sweeping line algorithm, combined_event_list returns a new event list representing the intervals in which at least n intervals in xs overlap - This function is used for both join and meet operations with different parameter n: 1 for join, 2 for meet *) - let combined_event_list lattice_op (xs:event list) = - let l = match lattice_op with `Join -> 1 | `Meet -> 2 in - let aux (interval_count, acc) = function - | Enter x -> (interval_count + 1, if (interval_count + 1) >= l && interval_count < l then (Enter x)::acc else acc) - | Exit x -> (interval_count - 1, if interval_count >= l && (interval_count - 1) < l then (Exit x)::acc else acc) - in - List.fold_left aux (0, []) xs |> snd |> List.rev - - let rec events_to_intervals = function - | [] -> [] - | (Enter x)::(Exit y)::xs -> (x, y)::(events_to_intervals xs) - | _ -> failwith "Invalid events list" - - let remove_empty_gaps (xs: t) = - let aux acc (l, r) = match acc with - | ((a, b)::acc') when (b +. Ints_t.one) >=. l -> (a, r)::acc' - | _ -> (l, r)::acc - in - List.fold_left aux [] xs |> List.rev - - let canonize (xs: t) = - interval_set_to_events xs |> - List.sort cmp_events |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let unop (x: t) op = match x with - | [] -> [] - | _ -> canonize @@ List.concat_map op x - - let binop (x: t) (y: t) op : t = match x, y with - | [], _ -> [] - | _, [] -> [] - | _, _ -> canonize @@ List.concat_map op (BatList.cartesian_product x y) - - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let minimal = function - | [] -> None - | (x, _)::_ -> Some x - - let maximal = function - | [] -> None - | xs -> Some (BatList.last xs |> snd) - - let equal_to_interval i (a, b) = - if a =. b && b =. i then - `Eq - else if a <=. i && i <=. b then - `Top - else - `Neq - - let equal_to i xs = match List.map (equal_to_interval i) xs with - | [] -> failwith "unsupported: equal_to with bottom" - | [`Eq] -> `Eq - | ys when List.for_all ((=) `Neq) ys -> `Neq - | _ -> `Top - - let norm_interval ?(suppress_ovwarn=false) ?(cast=false) ik (x,y) : t*overflow_info = - if x >. y then - ([],{underflow=false; overflow=false}) - else - let (min_ik, max_ik) = range ik in - let underflow = min_ik >. x in - let overflow = max_ik <. y in - let v = if underflow || overflow then - begin - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (max_ik -. min_ik) in - let resdiff = Ints_t.abs (y -. x) in - if resdiff >. diff then - [range ik] - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if l <=. u then - [(l, u)] - else - (* Interval that wraps around (begins to the right of its end). We CAN represent such intervals *) - [(min_ik, u); (l, max_ik)] - else if not cast && should_ignore_overflow ik then - [Ints_t.max min_ik x, Ints_t.min max_ik y] - else - [range ik] - end - else - [(x,y)] - in - if suppress_ovwarn then (v, {underflow=false; overflow=false}) else (v, {underflow; overflow}) - - let norm_intvs ?(suppress_ovwarn=false) ?(cast=false) (ik:ikind) (xs: t) : t*overflow_info = - let res = List.map (norm_interval ~suppress_ovwarn ~cast ik) xs in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let binary_op_with_norm op (ik:ikind) (x: t) (y: t) : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> norm_intvs ik @@ List.concat_map (fun (x,y) -> [op x y]) (BatList.cartesian_product x y) - - let binary_op_with_ovc (x: t) (y: t) op : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> - let res = List.map op (BatList.cartesian_product x y) in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let unary_op_with_norm op (ik:ikind) (x: t) = match x with - | [] -> ([],{overflow=false; underflow=false}) - | _ -> norm_intvs ik @@ List.concat_map (fun x -> [op x]) x - - let rec leq (xs: t) (ys: t) = - let leq_interval (al, au) (bl, bu) = al >=. bl && au <=. bu in - match xs, ys with - | [], _ -> true - | _, [] -> false - | (xl,xr)::xs', (yl,yr)::ys' -> - if leq_interval (xl,xr) (yl,yr) then - leq xs' ys - else if xr <. yl then - false - else - leq xs ys' - - let join ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let meet ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Meet |> - events_to_intervals - - let to_int = function - | [x] -> IArith.to_int x - | _ -> None - - let zero = [IArith.zero] - let one = [IArith.one] - let top_bool = [IArith.top_bool] - - let not_bool (x:t) = - let is_false x = equal x zero in - let is_true x = equal x one in - if is_true x then zero else if is_false x then one else top_bool - - let to_bool = function - | [(l,u)] when l =. Ints_t.zero && u =. Ints_t.zero -> Some false - | x -> if leq zero x then None else Some true - - let of_bool _ = function true -> one | false -> zero - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm_interval ~suppress_ovwarn ~cast:false ik (x,y) - - let of_int ik (x: int_t) = of_interval ik (x, x) - - let lt ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <. min_y then - of_bool ik true - else if min_x >=. max_y then - of_bool ik false - else - top_bool - - let le ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <=. min_y then - of_bool ik true - else if min_x >. max_y then - of_bool ik false - else - top_bool - - let gt ik x y = not_bool @@ le ik x y - - let ge ik x y = not_bool @@ lt ik x y - - let eq ik x y = match x, y with - | (a, b)::[], (c, d)::[] when a =. b && c =. d && a =. c -> - one - | _ -> - if is_bot (meet ik x y) then - zero - else - top_bool - - let ne ik x y = not_bool @@ eq ik x y - let interval_to_int i = Interval.to_int (Some i) - let interval_to_bool i = Interval.to_bool (Some i) - - let log f ik (i1, i2) = - match (interval_to_bool i1, interval_to_bool i2) with - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - - let bit f ik (i1, i2) = - match (interval_to_int i1), (interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - - let bitcomp f ik (i1, i2) = - match (interval_to_int i1, interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{overflow=false; underflow=false})) - | _, _ -> (top_of ik,{overflow=false; underflow=false}) - - let logand ik x y = - let interval_logand = bit Ints_t.logand ik in - binop x y interval_logand - - let logor ik x y = - let interval_logor = bit Ints_t.logor ik in - binop x y interval_logor - - let logxor ik x y = - let interval_logxor = bit Ints_t.logxor ik in - binop x y interval_logxor - - let lognot ik x = - let interval_lognot i = - match interval_to_int i with - | Some x -> of_int ik (Ints_t.lognot x) |> fst - | _ -> top_of ik - in - unop x interval_lognot - - let shift_left ik x y = - let interval_shiftleft = bitcomp (fun x y -> Ints_t.shift_left x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftleft - - let shift_right ik x y = - let interval_shiftright = bitcomp (fun x y -> Ints_t.shift_right x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftright - - let c_lognot ik x = - let log1 f ik i1 = - match interval_to_bool i1 with - | Some x -> of_bool ik (f x) - | _ -> top_of ik - in - let interval_lognot = log1 not ik in - unop x interval_lognot - - let c_logand ik x y = - let interval_logand = log (&&) ik in - binop x y interval_logand - - let c_logor ik x y = - let interval_logor = log (||) ik in - binop x y interval_logor - - let add ?no_ov = binary_op_with_norm IArith.add - let sub ?no_ov = binary_op_with_norm IArith.sub - let mul ?no_ov = binary_op_with_norm IArith.mul - let neg ?no_ov = unary_op_with_norm IArith.neg - - let div ?no_ov ik x y = - let rec interval_div x (y1, y2) = begin - let top_of ik = top_of ik |> List.hd in - let is_zero v = v =. Ints_t.zero in - match y1, y2 with - | l, u when is_zero l && is_zero u -> top_of ik (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> interval_div x (Ints_t.one,y2) - | _, u when is_zero u -> interval_div x (y1, Ints_t.(neg one)) - | _ when leq (of_int ik (Ints_t.zero) |> fst) ([(y1,y2)]) -> top_of ik - | _ -> IArith.div x (y1, y2) - end - in binary_op_with_norm interval_div ik x y - - let rem ik x y = - let interval_rem (x, y) = - if Interval.is_top_of ik (Some x) && Interval.is_top_of ik (Some y) then - top_of ik - else - let (xl, xu) = x in let (yl, yu) = y in - let pos x = if x <. Ints_t.zero then Ints_t.neg x else x in - let b = (Ints_t.max (pos yl) (pos yu)) -. Ints_t.one in - let range = if xl >=. Ints_t.zero then (Ints_t.zero, Ints_t.min xu b) else (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit Ints_t.rem ik (x, y)) [range] - in - binop x y interval_rem - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik x = norm_intvs ~cast:true ik x - - (* - narrows down the extremeties of xs if they are equal to boundary values of the ikind with (possibly) narrower values from ys - *) - let narrow ik xs ys = match xs ,ys with - | [], _ -> [] | _ ,[] -> xs - | _, _ -> - let min_xs = minimal xs |> Option.get in - let max_xs = maximal xs |> Option.get in - let min_ys = minimal ys |> Option.get in - let max_ys = maximal ys |> Option.get in - let min_range,max_range = range ik in - let threshold = get_interval_threshold_widening () in - let min = if min_xs =. min_range || threshold && min_ys >. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in - let max = if max_xs =. max_range || threshold && max_ys <. max_xs && IArith.is_upper_threshold max_xs then max_ys else max_xs in - xs - |> (function (_, y)::z -> (min, y)::z | _ -> []) - |> List.rev - |> (function (x, _)::z -> (x, max)::z | _ -> []) - |> List.rev - - (* - 1. partitions the intervals of xs by assigning each of them to the an interval in ys that includes it. - and joins all intervals in xs assigned to the same interval in ys as one interval. - 2. checks for every pair of adjacent pairs whether the pairs did approach (if you compare the intervals from xs and ys) and merges them if it is the case. - 3. checks whether partitions at the extremeties are approaching infinity (and expands them to infinity. in that case) - - The expansion (between a pair of adjacent partitions or at extremeties ) stops at a threshold. - *) - let widen ik xs ys = - let (min_ik,max_ik) = range ik in - let threshold = get_bool "ana.int.interval_threshold_widening" in - let upper_threshold (_,u) = IArith.upper_threshold u max_ik in - let lower_threshold (l,_) = IArith.lower_threshold l min_ik in - (*obtain partitioning of xs intervals according to the ys interval that includes them*) - let rec interval_sets_to_partitions (ik: ikind) (acc : (int_t * int_t) option) (xs: t) (ys: t)= - match xs,ys with - | _, [] -> [] - | [], (y::ys) -> (acc,y):: interval_sets_to_partitions ik None [] ys - | (x::xs), (y::ys) when Interval.leq (Some x) (Some y) -> interval_sets_to_partitions ik (Interval.join ik acc (Some x)) xs (y::ys) - | (x::xs), (y::ys) -> (acc,y) :: interval_sets_to_partitions ik None (x::xs) ys - in - let interval_sets_to_partitions ik xs ys = interval_sets_to_partitions ik None xs ys in - (*merge a pair of adjacent partitions*) - let merge_pair ik (a,b) (c,d) = - let new_a = function - | None -> Some (upper_threshold b, upper_threshold b) - | Some (ax,ay) -> Some (ax, upper_threshold b) - in - let new_c = function - | None -> Some (lower_threshold d, lower_threshold d) - | Some (cx,cy) -> Some (lower_threshold d, cy) - in - if threshold && (lower_threshold d +. Ints_t.one) >. (upper_threshold b) then - [(new_a a,(fst b, upper_threshold b)); (new_c c, (lower_threshold d, snd d))] - else - [(Interval.join ik a c, (Interval.join ik (Some b) (Some d) |> Option.get))] - in - let partitions_are_approaching part_left part_right = match part_left, part_right with - | (Some (_, left_x), (_, left_y)), (Some (right_x, _), (right_y, _)) -> (right_x -. left_x) >. (right_y -. left_y) - | _,_ -> false - in - (*merge all approaching pairs of adjacent partitions*) - let rec merge_list ik = function - | [] -> [] - | x::y::xs when partitions_are_approaching x y -> merge_list ik ((merge_pair ik x y) @ xs) - | x::xs -> x :: merge_list ik xs - in - (*expands left extremity*) - let widen_left = function - | [] -> [] - | (None,(lb,rb))::ts -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (None, (lt,rb))::ts - | (Some (la,ra), (lb,rb))::ts when lb <. la -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (Some (la,ra),(lt,rb))::ts - | x -> x - in - (*expands right extremity*) - let widen_right x = - let map_rightmost = function - | [] -> [] - | (None,(lb,rb))::ts -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (None, (lb,ut))::ts - | (Some (la,ra), (lb,rb))::ts when ra <. rb -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (Some (la,ra),(lb,ut))::ts - | x -> x - in - List.rev x |> map_rightmost |> List.rev - in - interval_sets_to_partitions ik xs ys |> merge_list ik |> widen_left |> widen_right |> List.map snd - - let starting ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (fst (range ik), n) - - let invariant_ikind e ik xs = - List.map (fun x -> Interval.invariant_ikind e ik (Some x)) xs |> - let open Invariant in List.fold_left (||) (bot ()) - - let modulo n k = - let result = Ints_t.rem n k in - if result >=. Ints_t.zero then result - else result +. k - - let refine_with_congruence ik (intvs: t) (cong: (int_t * int_t ) option): t = - let refine_with_congruence_interval ik (cong : (int_t * int_t ) option) (intv : (int_t * int_t ) option): t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if m =. Ints_t.zero && (c <. x || c >. y) then [] - else if m =. Ints_t.zero then - [(c, c)] - else - let (min_ik, max_ik) = range ik in - let rcx = - if x =. min_ik then x else - x +. (modulo (c -. x) (Ints_t.abs m)) in - let lcy = - if y =. max_ik then y else - y -. (modulo (y -. c) (Ints_t.abs m)) in - if rcx >. lcy then [] - else if rcx =. lcy then norm_interval ik (rcx, rcx) |> fst - else norm_interval ik (rcx, lcy) |> fst - | _ -> [] - in - List.concat_map (fun x -> refine_with_congruence_interval ik cong (Some x)) intvs - - let refine_with_interval ik xs = function None -> [] | Some (a,b) -> meet ik xs [(a,b)] - - let refine_with_incl_list ik intvs = function - | None -> intvs - | Some xs -> meet ik intvs (List.map (fun x -> (x,x)) xs) - - let excl_range_to_intervalset (ik: ikind) ((min, max): int_t * int_t) (excl: int_t): t = - let intv1 = (min, excl -. Ints_t.one) in - let intv2 = (excl +. Ints_t.one, max) in - norm_intvs ik ~suppress_ovwarn:true [intv1 ; intv2] |> fst - - let of_excl_list ik (excls: int_t list) = - let excl_list = List.map (excl_range_to_intervalset ik (range ik)) excls in - let res = List.fold_left (meet ik) (top_of ik) excl_list in - res - - let refine_with_excl_list ik (intv : t) = function - | None -> intv - | Some (xs, range) -> - let excl_to_intervalset (ik: ikind) ((rl, rh): (int64 * int64)) (excl: int_t): t = - excl_range_to_intervalset ik (Ints_t.of_bigint (Size.min_from_bit_range rl),Ints_t.of_bigint (Size.max_from_bit_range rh)) excl - in - let excl_list = List.map (excl_to_intervalset ik range) xs in - List.fold_left (meet ik) intv excl_list - - let project ik p t = t - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let list_pair_arb = QCheck.small_list pair_arb in - let canonize_randomly_generated_list = (fun x -> norm_intvs ik x |> fst) in - let shrink xs = GobQCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list - in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) canonize_randomly_generated_list list_pair_arb) -end - -module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct - include D - - let add ?no_ov ik x y = fst @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = fst @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = fst @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = fst @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = fst @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = fst @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = fst @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = fst @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = fst @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = fst @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = fst @@ D.shift_left ik x y - - let shift_right ik x y = fst @@ D.shift_right ik x y -end - -module IntIkind = struct let ikind () = Cil.IInt end -module Interval = IntervalFunctor (IntOps.BigIntOps) -module Interval32 = IntDomWithDefaultIkind (IntDomLifter (SOverflowUnlifter (IntervalFunctor (IntOps.Int64Ops)))) (IntIkind) -module IntervalSet = IntervalSetFunctor (IntOps.BigIntOps) -module Integers (Ints_t : IntOps.IntOps): IkindUnawareS with type t = Ints_t.t and type int_t = Ints_t.t = (* no top/bot, order is <= *) -struct - include Printable.Std - let name () = "integers" - type t = Ints_t.t [@@deriving eq, ord, hash] - type int_t = Ints_t.t - let top () = raise Unknown - let bot () = raise Error - let top_of ik = top () - let bot_of ik = bot () - let show (x: Ints_t.t) = Ints_t.to_string x - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - (* is_top and is_bot are never called, but if they were, the Std impl would raise their exception, so we overwrite them: *) - let is_top _ = false - let is_bot _ = false - - let equal_to i x = if i > x then `Neq else `Top - let leq x y = x <= y - let join x y = if Ints_t.compare x y > 0 then x else y - let widen = join - let meet x y = if Ints_t.compare x y > 0 then y else x - let narrow = meet - - let of_bool x = if x then Ints_t.one else Ints_t.zero - let to_bool' x = x <> Ints_t.zero - let to_bool x = Some (to_bool' x) - let of_int x = x - let to_int x = Some x - - let neg = Ints_t.neg - let add = Ints_t.add (* TODO: signed overflow is undefined behavior! *) - let sub = Ints_t.sub - let mul = Ints_t.mul - let div = Ints_t.div - let rem = Ints_t.rem - let lt n1 n2 = of_bool (n1 < n2) - let gt n1 n2 = of_bool (n1 > n2) - let le n1 n2 = of_bool (n1 <= n2) - let ge n1 n2 = of_bool (n1 >= n2) - let eq n1 n2 = of_bool (n1 = n2) - let ne n1 n2 = of_bool (n1 <> n2) - let lognot = Ints_t.lognot - let logand = Ints_t.logand - let logor = Ints_t.logor - let logxor = Ints_t.logxor - let shift_left n1 n2 = Ints_t.shift_left n1 (Ints_t.to_int n2) - let shift_right n1 n2 = Ints_t.shift_right n1 (Ints_t.to_int n2) - let c_lognot n1 = of_bool (not (to_bool' n1)) - let c_logand n1 n2 = of_bool ((to_bool' n1) && (to_bool' n2)) - let c_logor n1 n2 = of_bool ((to_bool' n1) || (to_bool' n2)) - let cast_to ?(suppress_ovwarn=false) ?torg t x = failwith @@ "Cast_to not implemented for " ^ (name ()) ^ "." - let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 (* TODO: use ikind *) - let invariant _ _ = Invariant.none (* TODO *) -end - -module FlatPureIntegers: IkindUnawareS with type t = int64 and type int_t = int64 = (* Integers, but raises Unknown/Error on join/meet *) -struct - include Integers(IntOps.Int64Ops) - let top () = raise Unknown - let bot () = raise Error - let leq = equal - let pretty_diff () (x,y) = Pretty.dprintf "Integer %a instead of %a" pretty x pretty y - let join x y = if equal x y then x else top () - let meet x y = if equal x y then x else bot () -end - -module Flat (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) -struct - type int_t = Base.int_t - include Lattice.FlatConf (struct - include Printable.DefaultConf - let top_name = "Unknown int" - let bot_name = "Error int" - end) (Base) - - let top_of ik = top () - let bot_of ik = bot () - - - let name () = "flat integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ikind x = top_of ikind - let ending ?(suppress_ovwarn=false) ikind x = top_of ikind - let maximal x = None - let minimal x = None - - let lift1 f x = match x with - | `Lifted x -> - (try `Lifted (f x) with Unknown -> `Top | Error -> `Bot) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> - (try `Lifted (f x y) with Unknown -> `Top | Error -> `Bot) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Lift (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) -struct - include Lattice.LiftPO (struct - include Printable.DefaultConf - let top_name = "MaxInt" - let bot_name = "MinInt" - end) (Base) - type int_t = Base.int_t - let top_of ik = top () - let bot_of ik = bot () - include StdTop (struct type nonrec t = t let top_of = top_of end) - - let name () = "lifted integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let lift1 f x = match x with - | `Lifted x -> `Lifted (f x) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> `Lifted (f x y) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Flattened = Flat (Integers (IntOps.Int64Ops)) -module Lifted = Lift (Integers (IntOps.Int64Ops)) - -module Reverse (Base: IkindUnawareS) = -struct - include Base - include (Lattice.Reverse (Base) : Lattice.S with type t := Base.t) -end - -module BISet = struct - include SetDomain.Make (IntOps.BigIntOps) - let is_singleton s = cardinal s = 1 -end - -(* The module [Exclusion] constains common functionality about handling of exclusion sets between [DefExc] and [Enums] *) -module Exclusion = -struct - module R = Interval32 - (* We use these types for the functions in this module to make the intended meaning more explicit *) - type t = Exc of BISet.t * Interval32.t - type inc = Inc of BISet.t [@@unboxed] - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.succ (Z.add (Z.neg (min_of_range r)) (max_of_range r)) - - let cardinality_BISet s = - Z.of_int (BISet.cardinal s) - - let leq_excl_incl (Exc (xs, r)) (Inc ys) = - (* For a <= b to hold, the cardinalities must fit, i.e. |a| <= |b|, which implies |min_r, max_r| - |xs| <= |ys|. We check this first. *) - let lower_bound_cardinality_a = Z.sub (cardinality_of_range r) (cardinality_BISet xs) in - let card_b = cardinality_BISet ys in - if Z.compare lower_bound_cardinality_a card_b > 0 then - false - else (* The cardinality did fit, so we check for all elements that are represented by range r, whether they are in (xs union ys) *) - let min_a = min_of_range r in - let max_a = max_of_range r in - GobZ.for_all_range (fun el -> BISet.mem el xs || BISet.mem el ys) (min_a, max_a) - - let leq (Exc (xs, r)) (Exc (ys, s)) = - let min_a, max_a = min_of_range r, max_of_range r in - let excluded_check = BISet.for_all (fun y -> BISet.mem y xs || Z.compare y min_a < 0 || Z.compare y max_a > 0) ys in (* if true, then the values ys, that are not in b, also do not occur in a *) - if not excluded_check - then false - else begin (* Check whether all elements that are in the range r, but not in s, are in xs, i.e. excluded. *) - if R.leq r s then true - else begin if Z.compare (cardinality_BISet xs) (Z.sub (cardinality_of_range r) (cardinality_of_range s)) >= 0 (* Check whether the number of excluded elements in a is as least as big as |min_r, max_r| - |min_s, max_s| *) - then - let min_b, max_b = min_of_range s, max_of_range s in - let leq1 = (* check whether the elements in [r_l; s_l-1] are all in xs, i.e. excluded *) - if Z.compare min_a min_b < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (min_a, Z.pred min_b) - else - true - in - let leq2 () = (* check whether the elements in [s_u+1; r_u] are all in xs, i.e. excluded *) - if Z.compare max_b max_a < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (Z.succ max_b, max_a) - else - true - in - leq1 && (leq2 ()) - else - false - end - end -end - -module DefExc : S with type int_t = Z.t = (* definite or set of excluded values *) -struct - module S = BISet - module R = Interval32 (* range for exclusion *) - - (* Ikind used for intervals representing the domain *) - let range_ikind = Cil.IInt - let size t = R.of_interval range_ikind (let a,b = Size.bits_i64 t in Int64.neg a,b) - - - type t = [ - | `Excluded of S.t * R.t - | `Definite of Z.t - | `Bot - ] [@@deriving eq, ord, hash] - type int_t = Z.t - let name () = "def_exc" - - - let top_range = R.of_interval range_ikind (-99L, 99L) (* Since there is no top ikind we use a range that includes both ILongLong [-63,63] and IULongLong [0,64]. Only needed for intermediate range computation on longs. Correct range is set by cast. *) - let top () = `Excluded (S.empty (), top_range) - let bot () = `Bot - let top_of ik = `Excluded (S.empty (), size ik) - let bot_of ik = bot () - - let show x = - let short_size x = "("^R.show x^")" in - match x with - | `Bot -> "Error int" - | `Definite x -> Z.to_string x - (* Print the empty exclusion as if it was a distinct top element: *) - | `Excluded (s,l) when S.is_empty s -> "Unknown int" ^ short_size l - (* Prepend the exclusion sets with something: *) - | `Excluded (s,l) -> "Not " ^ S.show s ^ short_size l - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let maximal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.max_of_range r) - | `Bot -> None - - let minimal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.min_of_range r) - | `Bot -> None - - let in_range r i = - if Z.compare i Z.zero < 0 then - let lowerb = Exclusion.min_of_range r in - Z.compare lowerb i <= 0 - else - let upperb = Exclusion.max_of_range r in - Z.compare i upperb <= 0 - - let is_top x = x = top () - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Definite x -> if i = x then `Eq else `Neq - | `Excluded (s,r) -> if S.mem i s then `Neq else `Top - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik = function - | `Excluded (s,r) -> - let r' = size ik in - if R.leq r r' then (* upcast -> no change *) - `Excluded (s, r) - else if ik = IBool then (* downcast to bool *) - if S.mem Z.zero s then - `Definite Z.one - else - `Excluded (S.empty(), r') - else - (* downcast: may overflow *) - (* let s' = S.map (Size.cast ik) s in *) - (* We want to filter out all i in s' where (t)x with x in r could be i. *) - (* Since this is hard to compute, we just keep all i in s' which overflowed, since those are safe - all i which did not overflow may now be possible due to overflow of r. *) - (* S.diff s' s, r' *) - (* The above is needed for test 21/03, but not sound! See example https://github.com/goblint/analyzer/pull/95#discussion_r483023140 *) - `Excluded (S.empty (), r') - | `Definite x -> `Definite (Size.cast ik x) - | `Bot -> `Bot - - (* Wraps definite values and excluded values according to the ikind. - * For an `Excluded s,r , assumes that r is already an overapproximation of the range of possible values. - * r might be larger than the possible range of this type; the range of the returned `Excluded set will be within the bounds of the ikind. - *) - let norm ik v = - match v with - | `Excluded (s, r) -> - let possibly_overflowed = not (R.leq r (size ik)) || not (S.for_all (in_range (size ik)) s) in - (* If no overflow occurred, just return x *) - if not possibly_overflowed then ( - v - ) - (* Else, if an overflow might have occurred but we should just ignore it *) - else if should_ignore_overflow ik then ( - let r = size ik in - (* filter out excluded elements that are not in the range *) - let mapped_excl = S.filter (in_range r) s in - `Excluded (mapped_excl, r) - ) - (* Else, if an overflow occurred that we should not treat with wrap-around, go to top *) - else if not (should_wrap ik) then ( - top_of ik - ) else ( - (* Else an overflow occurred that we should treat with wrap-around *) - let r = size ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - let mapped_excl = S.map (fun excl -> Size.cast ik excl) s in - match ik with - | IBool -> - begin match S.mem Z.zero mapped_excl, S.mem Z.one mapped_excl with - | false, false -> `Excluded (mapped_excl, r) (* Not {} -> Not {} *) - | true, false -> `Definite Z.one (* Not {0} -> 1 *) - | false, true -> `Definite Z.zero (* Not {1} -> 0 *) - | true, true -> `Bot (* Not {0, 1} -> bot *) - end - | ik -> - `Excluded (mapped_excl, r) - ) - | `Definite x -> - let min, max = Size.range ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - if should_wrap ik then ( - cast_to ik v - ) - else if Z.compare min x <= 0 && Z.compare x max <= 0 then ( - v - ) - else if should_ignore_overflow ik then ( - M.warn ~category:M.Category.Integer.overflow "DefExc: Value was outside of range, indicating overflow, but 'sem.int.signed_overflow' is 'assume_none' -> Returned Bot"; - `Bot - ) - else ( - top_of ik - ) - | `Bot -> `Bot - - let leq x y = match (x,y) with - (* `Bot <= x is always true *) - | `Bot, _ -> true - (* Anything except bot <= bot is always false *) - | _, `Bot -> false - (* Two known values are leq whenever equal *) - | `Definite (x: int_t), `Definite y -> x = y - (* A definite value is leq all exclusion sets that don't contain it *) - | `Definite x, `Excluded (s,r) -> in_range r x && not (S.mem x s) - (* No finite exclusion set can be leq than a definite value *) - | `Excluded (xs, xr), `Definite d -> - Exclusion.(leq_excl_incl (Exc (xs, xr)) (Inc (S.singleton d))) - | `Excluded (xs,xr), `Excluded (ys,yr) -> - Exclusion.(leq (Exc (xs,xr)) (Exc (ys, yr))) - - let join' ?range ik x y = - match (x,y) with - (* The least upper bound with the bottom element: *) - | `Bot, x -> x - | x, `Bot -> x - (* The case for two known values: *) - | `Definite (x: int_t), `Definite y -> - (* If they're equal, it's just THAT value *) - if x = y then `Definite x - (* Unless one of them is zero, we can exclude it: *) - else - let a,b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval range_ikind a) (R.of_interval range_ikind b) in - `Excluded ((if Z.equal x Z.zero || Z.equal y Z.zero then S.empty () else S.singleton Z.zero), r) - (* A known value and an exclusion set... the definite value should no - * longer be excluded: *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> - if not (in_range r x) then - let a = R.of_interval range_ikind (Size.min_range_sign_agnostic x) in - `Excluded (S.remove x s, R.join a r) - else - `Excluded (S.remove x s, r) - (* For two exclusion sets, only their intersection can be excluded: *) - | `Excluded (x,wx), `Excluded (y,wy) -> `Excluded (S.inter x y, range |? R.join wx wy) - - let join ik = join' ik - - - let widen ik x y = - if get_def_exc_widen_by_join () then - join' ik x y - else if equal x y then - x - else - join' ~range:(size ik) ik x y - - - let meet ik x y = - match (x,y) with - (* Greatest LOWER bound with the least element is trivial: *) - | `Bot, _ -> `Bot - | _, `Bot -> `Bot - (* Definite elements are either equal or the glb is bottom *) - | `Definite x, `Definite y -> if x = y then `Definite x else `Bot - (* The glb of a definite element and an exclusion set is either bottom or - * just the element itself, if it isn't in the exclusion set *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> if S.mem x s || not (in_range r x) then `Bot else `Definite x - (* The greatest lower bound of two exclusion sets is their union, this is - * just DeMorgans Law *) - | `Excluded (x,r1), `Excluded (y,r2) -> - let r' = R.meet r1 r2 in - let s' = S.union x y |> S.filter (in_range r') in - `Excluded (s', r') - - let narrow ik x y = x - - let of_int ik x = norm ik @@ `Definite x - let to_int x = match x with - | `Definite x -> Some x - | _ -> None - - let from_excl ikind (s: S.t) = norm ikind @@ `Excluded (s, size ikind) - - let of_bool_cmp ik x = of_int ik (if x then Z.one else Z.zero) - let of_bool = of_bool_cmp - let to_bool x = - match x with - | `Definite x -> Some (IntOps.BigIntOps.to_bool x) - | `Excluded (s,r) when S.mem Z.zero s -> Some true - | _ -> None - let top_bool = `Excluded (S.empty (), R.of_interval range_ikind (0L, 1L)) - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = - if Z.compare x y = 0 then - of_int ik x - else - let a, b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval ~suppress_ovwarn range_ikind a) (R.of_interval ~suppress_ovwarn range_ikind b) in - let ex = if Z.gt x Z.zero || Z.lt y Z.zero then S.singleton Z.zero else S.empty () in - norm ik @@ (`Excluded (ex, r)) - - let starting ?(suppress_ovwarn=false) ikind x = - let _,u_ik = Size.range ikind in - of_interval ~suppress_ovwarn ikind (x, u_ik) - - let ending ?(suppress_ovwarn=false) ikind x = - let l_ik,_ = Size.range ikind in - of_interval ~suppress_ovwarn ikind (l_ik, x) - - let of_excl_list t l = - let r = size t in (* elements in l are excluded from the full range of t! *) - `Excluded (List.fold_right S.add l (S.empty ()), r) - let is_excl_list l = match l with `Excluded _ -> true | _ -> false - let to_excl_list (x:t) = match x with - | `Definite _ -> None - | `Excluded (s,r) -> Some (S.elements s, (Option.get (R.minimal r), Option.get (R.maximal r))) - | `Bot -> None - - let to_incl_list x = match x with - | `Definite x -> Some [x] - | `Excluded _ -> None - | `Bot -> None - - let apply_range f r = (* apply f to the min/max of the old range r to get a new range *) - (* If the Int64 might overflow on us during computation, we instead go to top_range *) - match R.minimal r, R.maximal r with - | _ -> - let rf m = (size % Size.min_for % f) (m r) in - let r1, r2 = rf Exclusion.min_of_range, rf Exclusion.max_of_range in - R.join r1 r2 - - (* Default behaviour for unary operators, simply maps the function to the - * DefExc data structure. *) - let lift1 f ik x = norm ik @@ match x with - | `Excluded (s,r) -> - let s' = S.map f s in - `Excluded (s', apply_range f r) - | `Definite x -> `Definite (f x) - | `Bot -> `Bot - - let lift2 f ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite _ - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (f x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - (* Default behaviour for binary operators that are injective in either - * argument, so that Exclusion Sets can be used: *) - let lift2_inj f ik x y = - let def_exc f x s r = `Excluded (S.map (f x) s, apply_range (f x) r) in - norm ik @@ - match x,y with - (* If both are exclusion sets, there isn't anything we can do: *) - | `Excluded _, `Excluded _ -> top () - (* A definite value should be applied to all members of the exclusion set *) - | `Definite x, `Excluded (s,r) -> def_exc f x s r - (* Same thing here, but we should flip the operator to map it properly *) - | `Excluded (s,r), `Definite x -> def_exc (Batteries.flip f) x s r - (* The good case: *) - | `Definite x, `Definite y -> `Definite (f x y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The equality check: *) - let eq ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x equal to an exclusion set, if it is a member then NO otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt false else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt false else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x = y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The inequality check: *) - let ne ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x unequal to an exclusion set, if it is a member then Yes otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt true else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt true else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x <> y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - let neg ?no_ov ik (x :t) = norm ik @@ lift1 Z.neg ik x - let add ?no_ov ik x y = norm ik @@ lift2_inj Z.add ik x y - - let sub ?no_ov ik x y = norm ik @@ lift2_inj Z.sub ik x y - let mul ?no_ov ik x y = norm ik @@ match x, y with - | `Definite z, (`Excluded _ | `Definite _) when Z.equal z Z.zero -> x - | (`Excluded _ | `Definite _), `Definite z when Z.equal z Z.zero -> y - | `Definite a, `Excluded (s,r) - (* Integer multiplication with even numbers is not injective. *) - (* Thus we cannot exclude the values to which the exclusion set would be mapped to. *) - | `Excluded (s,r),`Definite a when Z.equal (Z.rem a (Z.of_int 2)) Z.zero -> `Excluded (S.empty (), apply_range (Z.mul a) r) - | _ -> lift2_inj Z.mul ik x y - let div ?no_ov ik x y = lift2 Z.div ik x y - let rem ik x y = lift2 Z.rem ik x y - - (* Comparison handling copied from Enums. *) - let handle_bot x y f = match x, y with - | `Bot, `Bot -> `Bot - | `Bot, _ - | _, `Bot -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> f () - - let lt ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 < 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 >= 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let gt ik x y = lt ik y x - - let le ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 <= 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 > 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let ge ik x y = le ik y x - - let lognot = lift1 Z.lognot - - let logand ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite i -> - (* Except in two special cases *) - if Z.equal i Z.zero then - `Definite Z.zero - else if Z.equal i Z.one then - of_interval IBool (Z.zero, Z.one) - else - top () - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (Z.logand x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - - let logor = lift2 Z.logor - let logxor = lift2 Z.logxor - - let shift (shift_op: int_t -> int -> int_t) (ik: Cil.ikind) (x: t) (y: t) = - (* BigInt only accepts int as second argument for shifts; perform conversion here *) - let shift_op_big_int a (b: int_t) = - let (b : int) = Z.to_int b in - shift_op a b - in - (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in - if is_negative (minimal x) || is_negative (minimal y) then - top_of ik - else - norm ik @@ lift2 shift_op_big_int ik x y - - let shift_left = - shift Z.shift_left - - let shift_right = - shift Z.shift_right - (* TODO: lift does not treat Not {0} as true. *) - let c_logand ik x y = - match to_bool x, to_bool y with - | Some false, _ - | _, Some false -> - of_bool ik false - | _, _ -> - lift2 IntOps.BigIntOps.c_logand ik x y - let c_logor ik x y = - match to_bool x, to_bool y with - | Some true, _ - | _, Some true -> - of_bool ik true - | _, _ -> - lift2 IntOps.BigIntOps.c_logor ik x y - let c_lognot ik = eq ik (of_int ik Z.zero) - - let invariant_ikind e ik (x:t) = - match x with - | `Definite x -> - IntInvariant.of_int e ik x - | `Excluded (s, r) -> - (* Emit range invariant if tighter than ikind bounds. - This can be more precise than interval, which has been widened. *) - let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let ri = IntInvariant.of_interval e ik (rmin, rmax) in - let si = IntInvariant.of_excl_list e ik (S.elements s) in - Invariant.(ri && si) - | `Bot -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - let excluded s = from_excl ik s in - let definite x = of_int ik x in - let shrink = function - | `Excluded (s, _) -> GobQCheck.shrink (S.arbitrary ()) s >|= excluded (* S TODO: possibly shrink excluded to definite *) - | `Definite x -> (return `Bot) <+> (GobQCheck.shrink (IntOps.BigIntOps.arbitrary ()) x >|= definite) - | `Bot -> empty - in - QCheck.frequency ~shrink ~print:show [ - 20, QCheck.map excluded (S.arbitrary ()); - 10, QCheck.map definite (IntOps.BigIntOps.arbitrary ()); - 1, QCheck.always `Bot - ] (* S TODO: decide frequencies *) - - let refine_with_congruence ik a b = a - let refine_with_interval ik a b = match a, b with - | x, Some(i) -> meet ik x (of_interval ik i) - | _ -> a - let refine_with_excl_list ik a b = match a, b with - | `Excluded (s, r), Some(ls, _) -> meet ik (`Excluded (s, r)) (of_excl_list ik ls) (* TODO: refine with excl range? *) - | _ -> a - let refine_with_incl_list ik a b = a - - let project ik p t = t -end (* 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. *) module Enums : S with type int_t = Z.t = struct @@ -2742,35 +367,3 @@ module Enums : S with type int_t = Z.t = struct let project ik p t = t end - -module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct - - include D - - let lift v = (v, {overflow=false; underflow=false}) - - let add ?no_ov ik x y = lift @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = lift @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = lift @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = lift @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = lift @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = lift @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = lift @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = lift @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = lift @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = lift @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = lift @@ D.shift_left ik x y - - let shift_right ik x y = lift @@ D.shift_right ik x y - -end From 94581ee6820d7c0668d99c9f4447b1d190eb8426 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:00:28 +0300 Subject: [PATCH 107/157] Remove Enums from IntDomain0 --- src/cdomain/value/cdomains/intDomain0.ml | 367 ----------------------- 1 file changed, 367 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/intDomain0.ml index 8dd8b07f74..1cda533c55 100644 --- a/src/cdomain/value/cdomains/intDomain0.ml +++ b/src/cdomain/value/cdomains/intDomain0.ml @@ -2376,373 +2376,6 @@ struct let project ik p t = t end -(* 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. *) -module Enums : S with type int_t = Z.t = struct - module R = Interval32 (* range for exclusion *) - - let range_ikind = Cil.IInt - let size t = R.of_interval range_ikind (let a,b = Size.bits_i64 t in Int64.neg a,b) - - type t = Inc of BISet.t | Exc of BISet.t * R.t [@@deriving eq, ord, hash] (* inclusion/exclusion set *) - - type int_t = Z.t - let name () = "enums" - let bot () = failwith "bot () not implemented for Enums" - let top () = failwith "top () not implemented for Enums" - let bot_of ik = Inc (BISet.empty ()) - let top_bool = Inc (BISet.of_list [Z.zero; Z.one]) - let top_of ik = - match ik with - | IBool -> top_bool - | _ -> Exc (BISet.empty (), size ik) - - let range ik = Size.range ik - -(* - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.add (Z.neg (min_of_range r)) (max_of_range r) *) - let value_in_range (min, max) v = Z.compare min v <= 0 && Z.compare v max <= 0 - - let show = function - | Inc xs when BISet.is_empty xs -> "bot" - | Inc xs -> "{" ^ (String.concat ", " (List.map Z.to_string (BISet.elements xs))) ^ "}" - | Exc (xs,r) -> "not {" ^ (String.concat ", " (List.map Z.to_string (BISet.elements xs))) ^ "} " ^ "("^R.show r^")" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - (* Normalization function for enums, that handles overflows for Inc. - As we do not compute on Excl, we do not have to perform any overflow handling for it. *) - let norm ikind v = - let min, max = range ikind in - (* Whether the value v lies within the values of the specified ikind. *) - let value_in_ikind v = - Z.compare min v <= 0 && Z.compare v max <= 0 - in - match v with - | Inc xs when BISet.for_all value_in_ikind xs -> v - | Inc xs -> - if should_wrap ikind then - Inc (BISet.map (Size.cast ikind) xs) - else if should_ignore_overflow ikind then - Inc (BISet.filter value_in_ikind xs) - else - top_of ikind - | Exc (xs, r) -> - (* The following assert should hold for Exc, therefore we do not have to overflow handling / normalization for it: - let range_in_ikind r = - R.leq r (size ikind) - in - let r_min, r_max = min_of_range r, max_of_range r in - assert (range_in_ikind r && BISet.for_all (value_in_range (r_min, r_max)) xs); *) - begin match ikind with - | IBool -> - begin match BISet.mem Z.zero xs, BISet.mem Z.one xs with - | false, false -> top_bool (* Not {} -> {0, 1} *) - | true, false -> Inc (BISet.singleton Z.one) (* Not {0} -> {1} *) - | false, true -> Inc (BISet.singleton Z.zero) (* Not {1} -> {0} *) - | true, true -> bot_of ikind (* Not {0, 1} -> bot *) - end - | _ -> - v - end - - - let equal_to i = function - | Inc x -> - if BISet.mem i x then - if BISet.is_singleton x then `Eq - else `Top - else `Neq - | Exc (x, r) -> - if BISet.mem i x then `Neq - else `Top - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik v = norm ik @@ match v with - | Exc (s,r) -> - let r' = size ik in - if R.leq r r' then (* upcast -> no change *) - Exc (s, r) - else if ik = IBool then (* downcast to bool *) - if BISet.mem Z.zero s then - Inc (BISet.singleton Z.one) - else - Exc (BISet.empty(), r') - else (* downcast: may overflow *) - Exc ((BISet.empty ()), r') - | Inc xs -> - let casted_xs = BISet.map (Size.cast ik) xs in - if Cil.isSigned ik && not (BISet.equal xs casted_xs) - then top_of ik (* When casting into a signed type and the result does not fit, the behavior is implementation-defined *) - else Inc casted_xs - - let of_int ikind x = cast_to ikind (Inc (BISet.singleton x)) - - let of_interval ?(suppress_ovwarn=false) ik (x, y) = - if Z.compare x y = 0 then - of_int ik x - else - let a, b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval ~suppress_ovwarn range_ikind a) (R.of_interval ~suppress_ovwarn range_ikind b) in - let ex = if Z.gt x Z.zero || Z.lt y Z.zero then BISet.singleton Z.zero else BISet.empty () in - norm ik @@ (Exc (ex, r)) - - let join _ x y = - match x, y with - | Inc x, Inc y -> Inc (BISet.union x y) - | Exc (x,r1), Exc (y,r2) -> Exc (BISet.inter x y, R.join r1 r2) - | Exc (x,r), Inc y - | Inc y, Exc (x,r) -> - let r = if BISet.is_empty y - then r - else - let (min_el_range, max_el_range) = Batteries.Tuple2.mapn (fun x -> R.of_interval range_ikind (Size.min_range_sign_agnostic x)) (BISet.min_elt y, BISet.max_elt y) in - let range = R.join min_el_range max_el_range in - R.join r range - in - Exc (BISet.diff x y, r) - - let meet _ x y = - match x, y with - | Inc x, Inc y -> Inc (BISet.inter x y) - | Exc (x,r1), Exc (y,r2) -> - let r = R.meet r1 r2 in - let r_min, r_max = Exclusion.min_of_range r, Exclusion.max_of_range r in - let filter_by_range = BISet.filter (value_in_range (r_min, r_max)) in - (* We remove those elements from the exclusion set that do not fit in the range anyway *) - let excl = BISet.union (filter_by_range x) (filter_by_range y) in - Exc (excl, r) - | Inc x, Exc (y,r) - | Exc (y,r), Inc x -> Inc (BISet.diff x y) - - let widen = join - let narrow = meet - let leq a b = - match a, b with - | Inc xs, Exc (ys, r) -> - if BISet.is_empty xs - then true - else - let min_b, max_b = Exclusion.min_of_range r, Exclusion.max_of_range r in - let min_a, max_a = BISet.min_elt xs, BISet.max_elt xs in - (* Check that the xs fit into the range r *) - Z.compare min_b min_a <= 0 && Z.compare max_a max_b <= 0 && - (* && check that none of the values contained in xs is excluded, i.e. contained in ys. *) - BISet.for_all (fun x -> not (BISet.mem x ys)) xs - | Inc xs, Inc ys -> - BISet.subset xs ys - | Exc (xs, r), Exc (ys, s) -> - Exclusion.(leq (Exc (xs, r)) (Exc (ys, s))) - | Exc (xs, r), Inc ys -> - Exclusion.(leq_excl_incl (Exc (xs, r)) (Inc ys)) - - let handle_bot x y f = match is_bot x, is_bot y with - | false, false -> f () - | true, false - | false, true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | true, true -> Inc (BISet.empty ()) - - let lift1 f ikind v = norm ikind @@ match v with - | Inc x when BISet.is_empty x -> v (* Return bottom when value is bottom *) - | Inc x when BISet.is_singleton x -> Inc (BISet.singleton (f (BISet.choose x))) - | _ -> top_of ikind - - let lift2 f (ikind: Cil.ikind) u v = - handle_bot u v (fun () -> - norm ikind @@ match u, v with - | Inc x,Inc y when BISet.is_singleton x && BISet.is_singleton y -> Inc (BISet.singleton (f (BISet.choose x) (BISet.choose y))) - | _,_ -> top_of ikind) - - let lift2 f ikind a b = - try lift2 f ikind a b with Division_by_zero -> top_of ikind - - let neg ?no_ov = lift1 Z.neg - let add ?no_ov ikind a b = - match a, b with - | Inc z,x when BISet.is_singleton z && BISet.choose z = Z.zero -> x - | x,Inc z when BISet.is_singleton z && BISet.choose z = Z.zero -> x - | x,y -> lift2 Z.add ikind x y - let sub ?no_ov = lift2 Z.sub - let mul ?no_ov ikind a b = - match a, b with - | Inc one,x when BISet.is_singleton one && BISet.choose one = Z.one -> x - | x,Inc one when BISet.is_singleton one && BISet.choose one = Z.one -> x - | Inc zero,_ when BISet.is_singleton zero && BISet.choose zero = Z.zero -> a - | _,Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> b - | x,y -> lift2 Z.mul ikind x y - - let div ?no_ov ikind a b = match a, b with - | x,Inc one when BISet.is_singleton one && BISet.choose one = Z.one -> x - | _,Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> top_of ikind - | Inc zero,_ when BISet.is_singleton zero && BISet.choose zero = Z.zero -> a - | x,y -> lift2 Z.div ikind x y - - let rem = lift2 Z.rem - - let lognot = lift1 Z.lognot - let logand = lift2 Z.logand - let logor = lift2 Z.logor - let logxor = lift2 Z.logxor - - let shift (shift_op: int_t -> int -> int_t) (ik: Cil.ikind) (x: t) (y: t) = - handle_bot x y (fun () -> - (* BigInt only accepts int as second argument for shifts; perform conversion here *) - let shift_op_big_int a (b: int_t) = - let (b : int) = Z.to_int b in - shift_op a b - in - (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in - if is_negative (minimal x) || is_negative (minimal y) then - top_of ik - else - lift2 shift_op_big_int ik x y) - - let shift_left = - shift Z.shift_left - - let shift_right = - shift Z.shift_right - - let of_bool ikind x = Inc (BISet.singleton (if x then Z.one else Z.zero)) - let to_bool = function - | Inc e when BISet.is_empty e -> None - | Exc (e,_) when BISet.is_empty e -> None - | Inc zero when BISet.is_singleton zero && BISet.choose zero = Z.zero -> Some false - | Inc xs when BISet.for_all ((<>) Z.zero) xs -> Some true - | Exc (xs,_) when BISet.exists ((=) Z.zero) xs -> Some true - | _ -> None - let to_int = function Inc x when BISet.is_singleton x -> Some (BISet.choose x) | _ -> None - - let to_excl_list = function Exc (x,r) when not (BISet.is_empty x) -> Some (BISet.elements x, (Option.get (R.minimal r), Option.get (R.maximal r))) | _ -> None - let of_excl_list ik xs = - let min_ik, max_ik = Size.range ik in - let exc = BISet.of_list @@ List.filter (value_in_range (min_ik, max_ik)) xs in - norm ik @@ Exc (exc, size ik) - let is_excl_list = BatOption.is_some % to_excl_list - let to_incl_list = function Inc s when not (BISet.is_empty s) -> Some (BISet.elements s) | _ -> None - - let starting ?(suppress_ovwarn=false) ikind x = - let _,u_ik = Size.range ikind in - of_interval ~suppress_ovwarn ikind (x, u_ik) - - let ending ?(suppress_ovwarn=false) ikind x = - let l_ik,_ = Size.range ikind in - of_interval ~suppress_ovwarn ikind (l_ik, x) - - let c_lognot ik x = - if is_bot x - then x - else - match to_bool x with - | Some b -> of_bool ik (not b) - | None -> top_bool - - let c_logand = lift2 IntOps.BigIntOps.c_logand - let c_logor = lift2 IntOps.BigIntOps.c_logor - let maximal = function - | Inc xs when not (BISet.is_empty xs) -> Some (BISet.max_elt xs) - | Exc (excl,r) -> - let rec decrement_while_contained v = - if BISet.mem v excl - then decrement_while_contained (Z.pred v) - else v - in - let range_max = Exclusion.max_of_range r in - Some (decrement_while_contained range_max) - | _ (* bottom case *) -> None - - let minimal = function - | Inc xs when not (BISet.is_empty xs) -> Some (BISet.min_elt xs) - | Exc (excl,r) -> - let rec increment_while_contained v = - if BISet.mem v excl - then increment_while_contained (Z.succ v) - else v - in - let range_min = Exclusion.min_of_range r in - Some (increment_while_contained range_min) - | _ (* bottom case *) -> None - - let lt ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 < 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 >= 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let gt ik x y = lt ik y x - - let le ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 <= 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 > 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let ge ik x y = le ik y x - - let eq ik x y = - handle_bot x y (fun () -> - match x, y with - | Inc xs, Inc ys when BISet.is_singleton xs && BISet.is_singleton ys -> of_bool ik (Z.equal (BISet.choose xs) (BISet.choose ys)) - | _, _ -> - if is_bot (meet ik x y) then - (* If the meet is empty, there is no chance that concrete values are equal *) - of_bool ik false - else - top_bool) - - let ne ik x y = c_lognot ik (eq ik x y) - - let invariant_ikind e ik x = - match x with - | Inc ps -> - IntInvariant.of_incl_list e ik (BISet.elements ps) - | Exc (ns, r) -> - (* Emit range invariant if tighter than ikind bounds. - This can be more precise than interval, which has been widened. *) - let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let ri = IntInvariant.of_interval e ik (rmin, rmax) in - let nsi = IntInvariant.of_excl_list e ik (BISet.elements ns) in - Invariant.(ri && nsi) - - - let arbitrary ik = - let open QCheck.Iter in - let neg s = of_excl_list ik (BISet.elements s) in - let pos s = norm ik (Inc s) in - let shrink = function - | Exc (s, _) -> GobQCheck.shrink (BISet.arbitrary ()) s >|= neg (* S TODO: possibly shrink neg to pos *) - | Inc s -> GobQCheck.shrink (BISet.arbitrary ()) s >|= pos - in - QCheck.frequency ~shrink ~print:show [ - 20, QCheck.map neg (BISet.arbitrary ()); - 10, QCheck.map pos (BISet.arbitrary ()); - ] (* S TODO: decide frequencies *) - - let refine_with_congruence ik a b = - let contains c m x = if Z.equal m Z.zero then Z.equal c x else Z.equal (Z.rem (Z.sub x c) m) Z.zero in - match a, b with - | Inc e, None -> bot_of ik - | Inc e, Some (c, m) -> Inc (BISet.filter (contains c m) e) - | _ -> a - - let refine_with_interval ik a b = a (* TODO: refine inclusion (exclusion?) set *) - - let refine_with_excl_list ik a b = - match b with - | Some (ls, _) -> meet ik a (of_excl_list ik ls) (* TODO: refine with excl range? *) - | _ -> a - - let refine_with_incl_list ik a b = - match a, b with - | Inc x, Some (ls) -> meet ik (Inc x) (Inc (BISet.of_list ls)) - | _ -> a - - let project ik p t = t -end - module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct include D From c4a3876e35c4d357f6abb4a91a1cc725326b0fe7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:02:32 +0300 Subject: [PATCH 108/157] Rename IntDomain0 -> DefExcDomain for split --- src/cdomain/value/cdomains/{intDomain0.ml => int/defExcDomain.ml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/cdomain/value/cdomains/{intDomain0.ml => int/defExcDomain.ml} (100%) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/int/defExcDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/intDomain0.ml rename to src/cdomain/value/cdomains/int/defExcDomain.ml From 108ab4410310978efe596c5a9bf922d17ab8b7e6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:02:59 +0300 Subject: [PATCH 109/157] Remove non-DefExcDomain parts --- .../value/cdomains/int/defExcDomain.ml | 1930 +---------------- 1 file changed, 1 insertion(+), 1929 deletions(-) diff --git a/src/cdomain/value/cdomains/int/defExcDomain.ml b/src/cdomain/value/cdomains/int/defExcDomain.ml index 1cda533c55..e747176631 100644 --- a/src/cdomain/value/cdomains/int/defExcDomain.ml +++ b/src/cdomain/value/cdomains/int/defExcDomain.ml @@ -1,1901 +1,5 @@ -open GobConfig -open GoblintCil -open Pretty -open PrecisionUtil +open IntDomain0 -module M = Messages - -let (%) = Batteries.(%) -let (|?) = Batteries.(|?) - -exception IncompatibleIKinds of string -exception Unknown -exception Error -exception ArithmeticOnIntegerBot of string - - - - -(** Define records that hold mutable variables representing different Configuration values. - * These values are used to keep track of whether or not the corresponding Config values are en-/disabled *) -type ana_int_config_values = { - mutable interval_threshold_widening : bool option; - mutable interval_narrow_by_meet : bool option; - mutable def_exc_widen_by_join : bool option; - mutable interval_threshold_widening_constants : string option; - mutable refinement : string option; -} - -let ana_int_config: ana_int_config_values = { - interval_threshold_widening = None; - interval_narrow_by_meet = None; - def_exc_widen_by_join = None; - interval_threshold_widening_constants = None; - refinement = None; -} - -let get_interval_threshold_widening () = - if ana_int_config.interval_threshold_widening = None then - ana_int_config.interval_threshold_widening <- Some (get_bool "ana.int.interval_threshold_widening"); - Option.get ana_int_config.interval_threshold_widening - -let get_interval_narrow_by_meet () = - if ana_int_config.interval_narrow_by_meet = None then - ana_int_config.interval_narrow_by_meet <- Some (get_bool "ana.int.interval_narrow_by_meet"); - Option.get ana_int_config.interval_narrow_by_meet - -let get_def_exc_widen_by_join () = - if ana_int_config.def_exc_widen_by_join = None then - ana_int_config.def_exc_widen_by_join <- Some (get_bool "ana.int.def_exc_widen_by_join"); - Option.get ana_int_config.def_exc_widen_by_join - -let get_interval_threshold_widening_constants () = - if ana_int_config.interval_threshold_widening_constants = None then - ana_int_config.interval_threshold_widening_constants <- Some (get_string "ana.int.interval_threshold_widening_constants"); - Option.get ana_int_config.interval_threshold_widening_constants - -let get_refinement () = - if ana_int_config.refinement = None then - ana_int_config.refinement <- Some (get_string "ana.int.refinement"); - Option.get ana_int_config.refinement - - - -(** Whether for a given ikind, we should compute with wrap-around arithmetic. - * Always for unsigned types, for signed types if 'sem.int.signed_overflow' is 'assume_wraparound' *) -let should_wrap ik = not (Cil.isSigned ik) || get_string "sem.int.signed_overflow" = "assume_wraparound" - -(** Whether for a given ikind, we should assume there are no overflows. - * Always false for unsigned types, true for signed types if 'sem.int.signed_overflow' is 'assume_none' *) -let should_ignore_overflow ik = Cil.isSigned ik && get_string "sem.int.signed_overflow" = "assume_none" - -let widening_thresholds = ResettableLazy.from_fun WideningThresholds.thresholds -let widening_thresholds_desc = ResettableLazy.from_fun (List.rev % WideningThresholds.thresholds) - -type overflow_info = { overflow: bool; underflow: bool;} - -let set_overflow_flag ~cast ~underflow ~overflow ik = - if !AnalysisState.executing_speculative_computations then - (* Do not produce warnings when the operations are not actually happening in code *) - () - else - let signed = Cil.isSigned ik in - if !AnalysisState.postsolving && signed && not cast then - AnalysisState.svcomp_may_overflow := true; - let sign = if signed then "Signed" else "Unsigned" in - match underflow, overflow with - | true, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190; CWE 191] "%s integer overflow and underflow" sign - | true, false -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 191] "%s integer underflow" sign - | false, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190] "%s integer overflow" sign - | false, false -> assert false - -let reset_lazy () = - ResettableLazy.reset widening_thresholds; - ResettableLazy.reset widening_thresholds_desc; - ana_int_config.interval_threshold_widening <- None; - ana_int_config.interval_narrow_by_meet <- None; - ana_int_config.def_exc_widen_by_join <- None; - ana_int_config.interval_threshold_widening_constants <- None; - ana_int_config.refinement <- None - -module type Arith = -sig - type t - val neg: t -> t - val add: t -> t -> t - val sub: t -> t -> t - val mul: t -> t -> t - val div: t -> t -> t - val rem: t -> t -> t - - val lt: t -> t -> t - val gt: t -> t -> t - val le: t -> t -> t - val ge: t -> t -> t - val eq: t -> t -> t - val ne: t -> t -> t - - val lognot: t -> t - val logand: t -> t -> t - val logor : t -> t -> t - val logxor: t -> t -> t - - val shift_left : t -> t -> t - val shift_right: t -> t -> t - - val c_lognot: t -> t - val c_logand: t -> t -> t - val c_logor : t -> t -> t - -end - -module type ArithIkind = -sig - type t - val neg: Cil.ikind -> t -> t - val add: Cil.ikind -> t -> t -> t - val sub: Cil.ikind -> t -> t -> t - val mul: Cil.ikind -> t -> t -> t - val div: Cil.ikind -> t -> t -> t - val rem: Cil.ikind -> t -> t -> t - - val lt: Cil.ikind -> t -> t -> t - val gt: Cil.ikind -> t -> t -> t - val le: Cil.ikind -> t -> t -> t - val ge: Cil.ikind -> t -> t -> t - val eq: Cil.ikind -> t -> t -> t - val ne: Cil.ikind -> t -> t -> t - - val lognot: Cil.ikind -> t -> t - val logand: Cil.ikind -> t -> t -> t - val logor : Cil.ikind -> t -> t -> t - val logxor: Cil.ikind -> t -> t -> t - - val shift_left : Cil.ikind -> t -> t -> t - val shift_right: Cil.ikind -> t -> t -> t - - val c_lognot: Cil.ikind -> t -> t - val c_logand: Cil.ikind -> t -> t -> t - val c_logor : Cil.ikind -> t -> t -> t - -end - -(* Shared functions between S and Z *) -module type B = -sig - include Lattice.S - type int_t - val bot_of: Cil.ikind -> t - val top_of: Cil.ikind -> t - val to_int: t -> int_t option - val equal_to: int_t -> t -> [`Eq | `Neq | `Top] - - val to_bool: t -> bool option - val to_excl_list: t -> (int_t list * (int64 * int64)) option - val of_excl_list: Cil.ikind -> int_t list -> t - val is_excl_list: t -> bool - - val to_incl_list: t -> int_t list option - - val maximal : t -> int_t option - val minimal : t -> int_t option - - val cast_to: ?suppress_ovwarn:bool -> ?torg:Cil.typ -> Cil.ikind -> t -> t -end - -(** Interface of IntDomain implementations that do not take ikinds for arithmetic operations yet. TODO: Should be ported to S in the future. *) -module type IkindUnawareS = -sig - include B - include Arith with type t := t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: int_t -> t - val of_bool: bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val arbitrary: unit -> t QCheck.arbitrary - val invariant: Cil.exp -> t -> Invariant.t -end - -(** Interface of IntDomain implementations taking an ikind for arithmetic operations *) -module type S = -sig - include B - include ArithIkind with type t:= t - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val neg : ?no_ov:bool -> Cil.ikind -> t -> t - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t - - val join: Cil.ikind -> t -> t -> t - val meet: Cil.ikind -> t -> t -> t - val narrow: Cil.ikind -> t -> t -> t - val widen: Cil.ikind -> t -> t -> t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val is_top_of: Cil.ikind -> t -> bool - val invariant_ikind : Cil.exp -> Cil.ikind -> t -> Invariant.t - - val refine_with_congruence: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_interval: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_excl_list: Cil.ikind -> t -> (int_t list * (int64 * int64)) option -> t - val refine_with_incl_list: Cil.ikind -> t -> int_t list option -> t - - val project: Cil.ikind -> int_precision -> t -> t - val arbitrary: Cil.ikind -> t QCheck.arbitrary -end - -module type SOverflow = -sig - - include S - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val neg : ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val of_int : Cil.ikind -> int_t -> t * overflow_info - - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t * overflow_info - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - - val shift_left : Cil.ikind -> t -> t -> t * overflow_info - - val shift_right : Cil.ikind -> t -> t -> t * overflow_info -end - -module type Y = -sig - (* include B *) - include B - include Arith with type t:= t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val is_top_of: Cil.ikind -> t -> bool - - val project: int_precision -> t -> t - val invariant: Cil.exp -> t -> Invariant.t -end - -module type Z = Y with type int_t = Z.t - - -module IntDomLifter (I : S) = -struct - open Cil - type int_t = I.int_t - type t = { v : I.t; ikind : CilType.Ikind.t } [@@deriving eq, ord, hash] - - let ikind {ikind; _} = ikind - - (* Helper functions *) - let check_ikinds x y = if x.ikind <> y.ikind then raise (IncompatibleIKinds (GobPretty.sprintf "ikinds %a and %a are incompatible. Values: %a and %a" CilType.Ikind.pretty x.ikind CilType.Ikind.pretty y.ikind I.pretty x.v I.pretty y.v)) - let lift op x = {x with v = op x.ikind x.v } - (* For logical operations the result is of type int *) - let lift_logical op x = {v = op x.ikind x.v; ikind = Cil.IInt} - let lift2 op x y = check_ikinds x y; {x with v = op x.ikind x.v y.v } - let lift2_cmp op x y = check_ikinds x y; {v = op x.ikind x.v y.v; ikind = Cil.IInt} - - let bot_of ikind = { v = I.bot_of ikind; ikind} - let bot () = failwith "bot () is not implemented for IntDomLifter." - let is_bot x = I.is_bot x.v - let top_of ikind = { v = I.top_of ikind; ikind} - let top () = failwith "top () is not implemented for IntDomLifter." - let is_top x = I.is_top x.v - - (* Leq does not check for ikind, because it is used in invariant with arguments of different type. - TODO: check ikinds here and fix invariant to work with right ikinds *) - let leq x y = I.leq x.v y.v - let join = lift2 I.join - let meet = lift2 I.meet - let widen = lift2 I.widen - let narrow = lift2 I.narrow - - let show x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - "⊤" - else - I.show x.v (* TODO add ikind to output *) - let pretty () x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - Pretty.text "⊤" - else - I.pretty () x.v (* TODO add ikind to output *) - let pretty_diff () (x, y) = I.pretty_diff () (x.v, y.v) (* TODO check ikinds, add them to output *) - let printXml o x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - BatPrintf.fprintf o "\n\n⊤\n\n\n" - else - I.printXml o x.v (* TODO add ikind to output *) - (* This is for debugging *) - let name () = "IntDomLifter(" ^ (I.name ()) ^ ")" - let to_yojson x = I.to_yojson x.v - let invariant e x = - let e' = Cilfacade.mkCast ~e ~newt:(TInt (x.ikind, [])) in - I.invariant_ikind e' x.ikind x.v - let tag x = I.tag x.v - let arbitrary ik = failwith @@ "Arbitrary not implement for " ^ (name ()) ^ "." - let to_int x = I.to_int x.v - let of_int ikind x = { v = I.of_int ikind x; ikind} - let equal_to i x = I.equal_to i x.v - let to_bool x = I.to_bool x.v - let of_bool ikind b = { v = I.of_bool ikind b; ikind} - let to_excl_list x = I.to_excl_list x.v - let of_excl_list ikind is = {v = I.of_excl_list ikind is; ikind} - let is_excl_list x = I.is_excl_list x.v - let to_incl_list x = I.to_incl_list x.v - let of_interval ?(suppress_ovwarn=false) ikind (lb,ub) = {v = I.of_interval ~suppress_ovwarn ikind (lb,ub); ikind} - let of_congruence ikind (c,m) = {v = I.of_congruence ikind (c,m); ikind} - let starting ?(suppress_ovwarn=false) ikind i = {v = I.starting ~suppress_ovwarn ikind i; ikind} - let ending ?(suppress_ovwarn=false) ikind i = {v = I.ending ~suppress_ovwarn ikind i; ikind} - let maximal x = I.maximal x.v - let minimal x = I.minimal x.v - - let neg = lift I.neg - let add = lift2 I.add - let sub = lift2 I.sub - let mul = lift2 I.mul - let div = lift2 I.div - let rem = lift2 I.rem - let lt = lift2_cmp I.lt - let gt = lift2_cmp I.gt - let le = lift2_cmp I.le - let ge = lift2_cmp I.ge - let eq = lift2_cmp I.eq - let ne = lift2_cmp I.ne - let lognot = lift I.lognot - let logand = lift2 I.logand - let logor = lift2 I.logor - let logxor = lift2 I.logxor - let shift_left x y = {x with v = I.shift_left x.ikind x.v y.v } (* TODO check ikinds*) - let shift_right x y = {x with v = I.shift_right x.ikind x.v y.v } (* TODO check ikinds*) - let c_lognot = lift_logical I.c_lognot - let c_logand = lift2 I.c_logand - let c_logor = lift2 I.c_logor - - let cast_to ?(suppress_ovwarn=false) ?torg ikind x = {v = I.cast_to ~suppress_ovwarn ~torg:(TInt(x.ikind,[])) ikind x.v; ikind} - - let is_top_of ik x = ik = x.ikind && I.is_top_of ik x.v - - let relift x = { v = I.relift x.v; ikind = x.ikind } - - let project p v = { v = I.project v.ikind p v.v; ikind = v.ikind } -end - -module type Ikind = -sig - val ikind: unit -> Cil.ikind -end - -module PtrDiffIkind : Ikind = -struct - let ikind = Cilfacade.ptrdiff_ikind -end - -module IntDomWithDefaultIkind (I: Y) (Ik: Ikind) : Y with type t = I.t and type int_t = I.int_t = -struct - include I - let top () = I.top_of (Ik.ikind ()) - let bot () = I.bot_of (Ik.ikind ()) -end - -module Size = struct (* size in bits as int, range as int64 *) - open Cil - let sign x = if Z.compare x Z.zero < 0 then `Signed else `Unsigned - - let top_typ = TInt (ILongLong, []) - let min_for x = intKindForValue x (sign x = `Unsigned) - let bit = function (* bits needed for representation *) - | IBool -> 1 - | ik -> bytesSizeOfInt ik * 8 - let is_int64_big_int x = Z.fits_int64 x - let card ik = (* cardinality *) - let b = bit ik in - Z.shift_left Z.one b - let bits ik = (* highest bits for neg/pos values *) - let s = bit ik in - if isSigned ik then s-1, s-1 else 0, s - let bits_i64 ik = BatTuple.Tuple2.mapn Int64.of_int (bits ik) - let range ik = - let a,b = bits ik in - let x = if isSigned ik then Z.neg (Z.shift_left Z.one a) (* -2^a *) else Z.zero in - let y = Z.pred (Z.shift_left Z.one b) in (* 2^b - 1 *) - x,y - - let is_cast_injective ~from_type ~to_type = - let (from_min, from_max) = range (Cilfacade.get_ikind from_type) in - let (to_min, to_max) = range (Cilfacade.get_ikind to_type) in - if M.tracing then M.trace "int" "is_cast_injective %a (%a, %a) -> %a (%a, %a)" CilType.Typ.pretty from_type GobZ.pretty from_min GobZ.pretty from_max CilType.Typ.pretty to_type GobZ.pretty to_min GobZ.pretty to_max; - Z.compare to_min from_min <= 0 && Z.compare from_max to_max <= 0 - - let cast t x = (* TODO: overflow is implementation-dependent! *) - if t = IBool then - (* C11 6.3.1.2 Boolean type *) - if Z.equal x Z.zero then Z.zero else Z.one - else - let a,b = range t in - let c = card t in - let y = Z.erem x c in - let y = if Z.gt y b then Z.sub y c - else if Z.lt y a then Z.add y c - else y - in - if M.tracing then M.tracel "cast" "Cast %a to range [%a, %a] (%a) = %a (%s in int64)" GobZ.pretty x GobZ.pretty a GobZ.pretty b GobZ.pretty c GobZ.pretty y (if is_int64_big_int y then "fits" else "does not fit"); - y - - let min_range_sign_agnostic x = - let size ik = - let a,b = bits_i64 ik in - Int64.neg a,b - in - if sign x = `Signed then - size (min_for x) - else - let a, b = size (min_for x) in - if b <= 64L then - let upper_bound_less = Int64.sub b 1L in - let max_one_less = Z.(pred @@ shift_left Z.one (Int64.to_int upper_bound_less)) in - if x <= max_one_less then - a, upper_bound_less - else - a,b - else - a, b - - (* From the number of bits used to represent a positive value, determines the maximal representable value *) - let max_from_bit_range pos_bits = Z.(pred @@ shift_left Z.one (to_int (Z.of_int64 pos_bits))) - - (* From the number of bits used to represent a non-positive value, determines the minimal representable value *) - let min_from_bit_range neg_bits = Z.(if neg_bits = 0L then Z.zero else neg @@ shift_left Z.one (to_int (neg (Z.of_int64 neg_bits)))) - -end - - -module StdTop (B: sig type t val top_of: Cil.ikind -> t end) = struct - open B - (* these should be overwritten for better precision if possible: *) - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ik x = top_of ik - let ending ?(suppress_ovwarn=false) ik x = top_of ik - let maximal x = None - let minimal x = None -end - -module Std (B: sig - type t - val name: unit -> string - val top_of: Cil.ikind -> t - val bot_of: Cil.ikind -> t - val show: t -> string - val equal: t -> t -> bool - end) = struct - include Printable.StdLeaf - let name = B.name (* overwrite the one from Printable.Std *) - open B - let is_top x = failwith "is_top not implemented for IntDomain.Std" - let is_bot x = B.equal x (bot_of Cil.IInt) (* Here we assume that the representation of bottom is independent of the ikind - This may be true for intdomain implementations, but not e.g. for IntDomLifter. *) - let is_top_of ik x = B.equal x (top_of ik) - - (* all output is based on B.show *) - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - let pretty_diff () (x,y) = dprintf "%s: %a instead of %a" (name ()) pretty x pretty y - - include StdTop (B) -end - -(* Textbook interval arithmetic, without any overflow handling etc. *) -module IntervalArith (Ints_t : IntOps.IntOps) = struct - let min4 a b c d = Ints_t.min (Ints_t.min a b) (Ints_t.min c d) - let max4 a b c d = Ints_t.max (Ints_t.max a b) (Ints_t.max c d) - - let mul (x1, x2) (y1, y2) = - let x1y1 = (Ints_t.mul x1 y1) in - let x1y2 = (Ints_t.mul x1 y2) in - let x2y1 = (Ints_t.mul x2 y1) in - let x2y2 = (Ints_t.mul x2 y2) in - (min4 x1y1 x1y2 x2y1 x2y2, max4 x1y1 x1y2 x2y1 x2y2) - - let shift_left (x1,x2) (y1,y2) = - let y1p = Ints_t.shift_left Ints_t.one y1 in - let y2p = Ints_t.shift_left Ints_t.one y2 in - mul (x1, x2) (y1p, y2p) - - let div (x1, x2) (y1, y2) = - let x1y1n = (Ints_t.div x1 y1) in - let x1y2n = (Ints_t.div x1 y2) in - let x2y1n = (Ints_t.div x2 y1) in - let x2y2n = (Ints_t.div x2 y2) in - let x1y1p = (Ints_t.div x1 y1) in - let x1y2p = (Ints_t.div x1 y2) in - let x2y1p = (Ints_t.div x2 y1) in - let x2y2p = (Ints_t.div x2 y2) in - (min4 x1y1n x1y2n x2y1n x2y2n, max4 x1y1p x1y2p x2y1p x2y2p) - - let add (x1, x2) (y1, y2) = (Ints_t.add x1 y1, Ints_t.add x2 y2) - let sub (x1, x2) (y1, y2) = (Ints_t.sub x1 y2, Ints_t.sub x2 y1) - - let neg (x1, x2) = (Ints_t.neg x2, Ints_t.neg x1) - - let one = (Ints_t.one, Ints_t.one) - let zero = (Ints_t.zero, Ints_t.zero) - let top_bool = (Ints_t.zero, Ints_t.one) - - let to_int (x1, x2) = - if Ints_t.equal x1 x2 then Some x1 else None - - let upper_threshold u max_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - let max_ik' = Ints_t.to_bigint max_ik in - let t = List.find_opt (fun x -> Z.compare u x <= 0 && Z.compare x max_ik' <= 0) ts in - BatOption.map_default Ints_t.of_bigint max_ik t - let lower_threshold l min_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - let min_ik' = Ints_t.to_bigint min_ik in - let t = List.find_opt (fun x -> Z.compare l x >= 0 && Z.compare x min_ik' >= 0) ts in - BatOption.map_default Ints_t.of_bigint min_ik t - let is_upper_threshold u = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - List.exists (Z.equal u) ts - let is_lower_threshold l = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - List.exists (Z.equal l) ts -end - -module IntInvariant = -struct - let of_int e ik x = - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.none - - let of_incl_list e ik ps = - match ps with - | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> - assert (List.mem Z.zero ps); - assert (List.mem Z.one ps); - Invariant.none - | [_] when get_bool "witness.invariant.exact" -> - Invariant.none - | _ :: _ :: _ - | [_] | [] -> - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ps - - let of_interval_opt e ik = function - | (Some x1, Some x2) when Z.equal x1 x2 -> - of_int e ik x1 - | x1_opt, x2_opt -> - let (min_ik, max_ik) = Size.range ik in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = - match x1_opt, inexact_type_bounds with - | Some x1, false when Z.equal min_ik x1 -> Invariant.none - | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) - | None, _ -> Invariant.none - in - let i2 = - match x2_opt, inexact_type_bounds with - | Some x2, false when Z.equal x2 max_ik -> Invariant.none - | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) - | None, _ -> Invariant.none - in - Invariant.(i1 && i2) - - let of_interval e ik (x1, x2) = - of_interval_opt e ik (Some x1, Some x2) - - let of_excl_list e ik ns = - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) (Invariant.top ()) ns -end - -module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = -struct - let name () = "intervals" - type int_t = Ints_t.t - type t = (Ints_t.t * Ints_t.t) option [@@deriving eq, ord, hash] - module IArith = IntervalArith (Ints_t) - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - let top_of ik = Some (range ik) - let bot () = None - let bot_of ik = bot () (* TODO: improve *) - - let show = function None -> "bottom" | Some (x,y) -> "["^Ints_t.to_string x^","^Ints_t.to_string y^"]" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) -> - if a = b && b = i then `Eq else if Ints_t.compare a i <= 0 && Ints_t.compare i b <=0 then `Top else `Neq - - let norm ?(suppress_ovwarn=false) ?(cast=false) ik : (t -> t * overflow_info) = function None -> (None, {underflow=false; overflow=false}) | Some (x,y) -> - if Ints_t.compare x y > 0 then - (None,{underflow=false; overflow=false}) - else ( - let (min_ik, max_ik) = range ik in - let underflow = Ints_t.compare min_ik x > 0 in - let overflow = Ints_t.compare max_ik y < 0 in - let ov_info = { underflow = underflow && not suppress_ovwarn; overflow = overflow && not suppress_ovwarn } in - let v = - if underflow || overflow then - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (Ints_t.sub max_ik min_ik) in - let resdiff = Ints_t.abs (Ints_t.sub y x) in - if Ints_t.compare resdiff diff > 0 then - top_of ik - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if Ints_t.compare l u <= 0 then - Some (l, u) - else - (* Interval that wraps around (begins to the right of its end). We can not represent such intervals *) - top_of ik - else if not cast && should_ignore_overflow ik then - let tl, tu = BatOption.get @@ top_of ik in - Some (Ints_t.max tl x, Ints_t.min tu y) - else - top_of ik - else - Some (x,y) - in - (v, ov_info) - ) - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (x1,x2), Some (y1,y2) -> Ints_t.compare x1 y1 >= 0 && Ints_t.compare x2 y2 <= 0 - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.min x1 y1, Ints_t.max x2 y2) |> fst - - let meet ik (x:t) y = - match x, y with - | None, z | z, None -> None - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.max x1 y1, Ints_t.min x2 y2) |> fst - - (* TODO: change to_int signature so it returns a big_int *) - let to_int x = Option.bind x (IArith.to_int) - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm ~suppress_ovwarn ik @@ Some (x,y) - let of_int ik (x: int_t) = of_interval ik (x,x) - let zero = Some IArith.zero - let one = Some IArith.one - let top_bool = Some IArith.top_bool - - let of_bool _ik = function true -> one | false -> zero - let to_bool (a: t) = match a with - | None -> None - | Some (l, u) when Ints_t.compare l Ints_t.zero = 0 && Ints_t.compare u Ints_t.zero = 0 -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (fst (range ik), n) - - (* TODO: change signature of maximal, minimal to return big_int*) - let maximal = function None -> None | Some (x,y) -> Some y - let minimal = function None -> None | Some (x,y) -> Some x - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov t = norm ~cast:true t (* norm does all overflow handling *) - - let widen ik x y = - match x, y with - | None, z | z, None -> z - | Some (l0,u0), Some (l1,u1) -> - let (min_ik, max_ik) = range ik in - let threshold = get_interval_threshold_widening () in - let l2 = - if Ints_t.compare l0 l1 = 0 then l0 - else if threshold then IArith.lower_threshold l1 min_ik - else min_ik - in - let u2 = - if Ints_t.compare u0 u1 = 0 then u0 - else if threshold then IArith.upper_threshold u1 max_ik - else max_ik - in - norm ik @@ Some (l2,u2) |> fst - let widen ik x y = - let r = widen ik x y in - if M.tracing && not (equal x y) then M.tracel "int" "interval widen %a %a -> %a" pretty x pretty y pretty r; - assert (leq x y); (* TODO: remove for performance reasons? *) - r - - let narrow ik x y = - match x, y with - | _,None | None, _ -> None - | Some (x1,x2), Some (y1,y2) -> - let threshold = get_interval_threshold_widening () in - let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 || threshold && Ints_t.compare y1 x1 > 0 && IArith.is_lower_threshold x1 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 || threshold && Ints_t.compare y2 x2 < 0 && IArith.is_upper_threshold x2 then y2 else x2 in - norm ik @@ Some (lr,ur) |> fst - - - let narrow ik x y = - if get_interval_narrow_by_meet () then - meet ik x y - else - narrow ik x y - - let log f ~annihilator ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, _ when x = annihilator -> of_bool ik annihilator - | _, Some y when y = annihilator -> of_bool ik annihilator - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) ~annihilator:true - let c_logand = log (&&) ~annihilator:false - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let bit f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - let bitcomp f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{underflow=false; overflow=false})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let logxor = bit (fun _ik -> Ints_t.logxor) - - let logand ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (Ints_t.logand x y) |> fst with Division_by_zero -> top_of ik) - | _, Some y when Ints_t.equal y Ints_t.zero -> of_int ik Ints_t.zero |> fst - | _, Some y when Ints_t.equal y Ints_t.one -> of_interval ik (Ints_t.zero, Ints_t.one) |> fst - | _ -> top_of ik - - let logor = bit (fun _ik -> Ints_t.logor) - - let bit1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_int i1 with - | Some x -> of_int ik (f ik x) |> fst - | _ -> top_of ik - - let lognot = bit1 (fun _ik -> Ints_t.lognot) - let shift_right = bitcomp (fun _ik x y -> Ints_t.shift_right x (Ints_t.to_int y)) - - let neg ?no_ov ik = function None -> (None,{underflow=false; overflow=false}) | Some x -> norm ik @@ Some (IArith.neg x) - - let binary_op_with_norm ?no_ov op ik x y = match x, y with - | None, None -> (None, {overflow=false; underflow= false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some x, Some y -> norm ik @@ Some (op x y) - - let add ?no_ov = binary_op_with_norm IArith.add - let mul ?no_ov = binary_op_with_norm IArith.mul - let sub ?no_ov = binary_op_with_norm IArith.sub - - let shift_left ik a b = - match is_bot a, is_bot b with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show a) (show b))) - | _ -> - match a, minimal b, maximal b with - | Some a, Some bl, Some bu when (Ints_t.compare bl Ints_t.zero >= 0) -> - (try - let r = IArith.shift_left a (Ints_t.to_int bl, Ints_t.to_int bu) in - norm ik @@ Some r - with Z.Overflow -> (top_of ik,{underflow=false; overflow=true})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let rem ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (xl, xu), Some (yl, yu) -> - if is_top_of ik x && is_top_of ik y then - (* This is needed to preserve soundness also on things bigger than int32 e.g. *) - (* x: 3803957176L -> T in Interval32 *) - (* y: 4209861404L -> T in Interval32 *) - (* x % y: 3803957176L -> T in Interval32 *) - (* T in Interval32 is [-2147483648,2147483647] *) - (* the code below computes [-2147483647,2147483647] for this though which is unsound *) - top_of ik - else - (* If we have definite values, Ints_t.rem will give a definite result. - * Otherwise we meet with a [range] the result can be in. - * This range is [0, min xu b] if x is positive, and [max xl -b, min xu b] if x can be negative. - * The precise bound b is one smaller than the maximum bound. Negative y give the same result as positive. *) - let pos x = if Ints_t.compare x Ints_t.zero < 0 then Ints_t.neg x else x in - let b = Ints_t.sub (Ints_t.max (pos yl) (pos yu)) Ints_t.one in - let range = if Ints_t.compare xl Ints_t.zero>= 0 then Some (Ints_t.zero, Ints_t.min xu b) else Some (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit (fun _ik -> Ints_t.rem) ik x y) range - - let rec div ?no_ov ik x y = - match x, y with - | None, None -> (bot (),{underflow=false; overflow=false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | (Some (x1,x2) as x), (Some (y1,y2) as y) -> - begin - let is_zero v = Ints_t.compare v Ints_t.zero = 0 in - match y1, y2 with - | l, u when is_zero l && is_zero u -> (top_of ik,{underflow=false; overflow=false}) (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> div ik (Some (x1,x2)) (Some (Ints_t.one,y2)) - | _, u when is_zero u -> div ik (Some (x1,x2)) (Some (y1, Ints_t.(neg one))) - | _ when leq (of_int ik (Ints_t.zero) |> fst) (Some (y1,y2)) -> (top_of ik,{underflow=false; overflow=false}) - | _ -> binary_op_with_norm IArith.div ik x y - end - - let ne ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik true - else if Ints_t.compare x2 y1 <= 0 && Ints_t.compare y2 x1 <= 0 then - of_bool ik false - else top_bool - - let eq ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 && Ints_t.compare x2 y1 <= 0 then - of_bool ik true - else if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik false - else top_bool - - let ge ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 then of_bool ik true - else if Ints_t.compare x2 y1 < 0 then of_bool ik false - else top_bool - - let le ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 <= 0 then of_bool ik true - else if Ints_t.compare y2 x1 < 0 then of_bool ik false - else top_bool - - let gt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 then of_bool ik true - else if Ints_t.compare x2 y1 <= 0 then of_bool ik false - else top_bool - - let lt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 < 0 then of_bool ik true - else if Ints_t.compare y2 x1 <= 0 then of_bool ik false - else top_bool - - let invariant_ikind e ik = function - | Some (x1, x2) -> - let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in - IntInvariant.of_interval e ik (x1', x2') - | None -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let shrink = function - | Some (l, u) -> (return None) <+> (GobQCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) - | None -> empty - in - QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) (fun x -> of_interval ik x |> fst ) pair_arb) - - let modulo n k = - let result = Ints_t.rem n k in - if Ints_t.compare result Ints_t.zero >= 0 then result - else Ints_t.add result k - - let refine_with_congruence ik (intv : t) (cong : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if Ints_t.equal m Ints_t.zero && (Ints_t.compare c x < 0 || Ints_t.compare c y > 0) then None - else if Ints_t.equal m Ints_t.zero then - Some (c, c) - else - let (min_ik, max_ik) = range ik in - let rcx = - if Ints_t.equal x min_ik then x else - Ints_t.add x (modulo (Ints_t.sub c x) (Ints_t.abs m)) in - let lcy = - if Ints_t.equal y max_ik then y else - Ints_t.sub y (modulo (Ints_t.sub y c) (Ints_t.abs m)) in - if Ints_t.compare rcx lcy > 0 then None - else if Ints_t.equal rcx lcy then norm ik @@ Some (rcx, rcx) |> fst - else norm ik @@ Some (rcx, lcy) |> fst - | _ -> None - - let refine_with_congruence ik x y = - let refn = refine_with_congruence ik x y in - if M.tracing then M.trace "refine" "int_refine_with_congruence %a %a -> %a" pretty x pretty y pretty refn; - refn - - let refine_with_interval ik a b = meet ik a b - - let refine_with_excl_list ik (intv : t) (excl : (int_t list * (int64 * int64)) option) : t = - match intv, excl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls, (rl, rh)) -> - let rec shrink op b = - let new_b = (op b (Ints_t.of_int(Bool.to_int(BatList.mem_cmp Ints_t.compare b ls)))) in - if not (Ints_t.equal b new_b) then shrink op new_b else new_b - in - let (min_ik, max_ik) = range ik in - let l' = if Ints_t.equal l min_ik then l else shrink Ints_t.add l in - let u' = if Ints_t.equal u max_ik then u else shrink Ints_t.sub u in - let intv' = norm ik @@ Some (l', u') |> fst in - let range = norm ~suppress_ovwarn:true ik (Some (Ints_t.of_bigint (Size.min_from_bit_range rl), Ints_t.of_bigint (Size.max_from_bit_range rh))) |> fst in - meet ik intv' range - - let refine_with_incl_list ik (intv: t) (incl : (int_t list) option) : t = - match intv, incl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls) -> - let rec min m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> min (Some x) xs | Some m -> if Ints_t.compare m x < 0 then min (Some m) xs else min (Some x) xs in - let rec max m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> max (Some x) xs | Some m -> if Ints_t.compare m x > 0 then max (Some m) xs else max (Some x) xs in - match min None ls, max None ls with - | Some m1, Some m2 -> refine_with_interval ik (Some(l, u)) (Some (m1, m2)) - | _, _-> intv - - let project ik p t = t -end - -(** IntervalSetFunctor that is not just disjunctive completion of intervals, but attempts to be precise for wraparound arithmetic for unsigned types *) -module IntervalSetFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) list = -struct - - module Interval = IntervalFunctor (Ints_t) - module IArith = IntervalArith (Ints_t) - - - let name () = "interval_sets" - - type int_t = Ints_t.t - - let (>.) a b = Ints_t.compare a b > 0 - let (=.) a b = Ints_t.compare a b = 0 - let (<.) a b = Ints_t.compare a b < 0 - let (>=.) a b = Ints_t.compare a b >= 0 - let (<=.) a b = Ints_t.compare a b <= 0 - let (+.) a b = Ints_t.add a b - let (-.) a b = Ints_t.sub a b - - (* - Each domain's element is guaranteed to be in canonical form. That is, each interval contained - inside the set does not overlap with each other and they are not adjacent. - *) - type t = (Ints_t.t * Ints_t.t) list [@@deriving eq, hash, ord] - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - - let top_of ik = [range ik] - - let bot () = [] - - let bot_of ik = bot () - - let show (x: t) = - let show_interval i = Printf.sprintf "[%s, %s]" (Ints_t.to_string (fst i)) (Ints_t.to_string (snd i)) in - List.fold_left (fun acc i -> (show_interval i) :: acc) [] x |> List.rev |> String.concat ", " |> Printf.sprintf "[%s]" - - (* New type definition for the sweeping line algorithm used for implementing join/meet functions. *) - type event = Enter of Ints_t.t | Exit of Ints_t.t - - let unbox_event = function Enter x -> x | Exit x -> x - - let cmp_events x y = - (* Deliberately comparing ints first => Cannot be derived *) - let res = Ints_t.compare (unbox_event x) (unbox_event y) in - if res <> 0 then res - else - begin - match (x, y) with - | (Enter _, Exit _) -> -1 - | (Exit _, Enter _) -> 1 - | (_, _) -> 0 - end - - let interval_set_to_events (xs: t) = - List.concat_map (fun (a, b) -> [Enter a; Exit b]) xs - - let two_interval_sets_to_events (xs: t) (ys: t) = - let xs = interval_set_to_events xs in - let ys = interval_set_to_events ys in - List.merge cmp_events xs ys - - (* Using the sweeping line algorithm, combined_event_list returns a new event list representing the intervals in which at least n intervals in xs overlap - This function is used for both join and meet operations with different parameter n: 1 for join, 2 for meet *) - let combined_event_list lattice_op (xs:event list) = - let l = match lattice_op with `Join -> 1 | `Meet -> 2 in - let aux (interval_count, acc) = function - | Enter x -> (interval_count + 1, if (interval_count + 1) >= l && interval_count < l then (Enter x)::acc else acc) - | Exit x -> (interval_count - 1, if interval_count >= l && (interval_count - 1) < l then (Exit x)::acc else acc) - in - List.fold_left aux (0, []) xs |> snd |> List.rev - - let rec events_to_intervals = function - | [] -> [] - | (Enter x)::(Exit y)::xs -> (x, y)::(events_to_intervals xs) - | _ -> failwith "Invalid events list" - - let remove_empty_gaps (xs: t) = - let aux acc (l, r) = match acc with - | ((a, b)::acc') when (b +. Ints_t.one) >=. l -> (a, r)::acc' - | _ -> (l, r)::acc - in - List.fold_left aux [] xs |> List.rev - - let canonize (xs: t) = - interval_set_to_events xs |> - List.sort cmp_events |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let unop (x: t) op = match x with - | [] -> [] - | _ -> canonize @@ List.concat_map op x - - let binop (x: t) (y: t) op : t = match x, y with - | [], _ -> [] - | _, [] -> [] - | _, _ -> canonize @@ List.concat_map op (BatList.cartesian_product x y) - - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let minimal = function - | [] -> None - | (x, _)::_ -> Some x - - let maximal = function - | [] -> None - | xs -> Some (BatList.last xs |> snd) - - let equal_to_interval i (a, b) = - if a =. b && b =. i then - `Eq - else if a <=. i && i <=. b then - `Top - else - `Neq - - let equal_to i xs = match List.map (equal_to_interval i) xs with - | [] -> failwith "unsupported: equal_to with bottom" - | [`Eq] -> `Eq - | ys when List.for_all ((=) `Neq) ys -> `Neq - | _ -> `Top - - let norm_interval ?(suppress_ovwarn=false) ?(cast=false) ik (x,y) : t*overflow_info = - if x >. y then - ([],{underflow=false; overflow=false}) - else - let (min_ik, max_ik) = range ik in - let underflow = min_ik >. x in - let overflow = max_ik <. y in - let v = if underflow || overflow then - begin - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (max_ik -. min_ik) in - let resdiff = Ints_t.abs (y -. x) in - if resdiff >. diff then - [range ik] - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if l <=. u then - [(l, u)] - else - (* Interval that wraps around (begins to the right of its end). We CAN represent such intervals *) - [(min_ik, u); (l, max_ik)] - else if not cast && should_ignore_overflow ik then - [Ints_t.max min_ik x, Ints_t.min max_ik y] - else - [range ik] - end - else - [(x,y)] - in - if suppress_ovwarn then (v, {underflow=false; overflow=false}) else (v, {underflow; overflow}) - - let norm_intvs ?(suppress_ovwarn=false) ?(cast=false) (ik:ikind) (xs: t) : t*overflow_info = - let res = List.map (norm_interval ~suppress_ovwarn ~cast ik) xs in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let binary_op_with_norm op (ik:ikind) (x: t) (y: t) : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> norm_intvs ik @@ List.concat_map (fun (x,y) -> [op x y]) (BatList.cartesian_product x y) - - let binary_op_with_ovc (x: t) (y: t) op : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> - let res = List.map op (BatList.cartesian_product x y) in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let unary_op_with_norm op (ik:ikind) (x: t) = match x with - | [] -> ([],{overflow=false; underflow=false}) - | _ -> norm_intvs ik @@ List.concat_map (fun x -> [op x]) x - - let rec leq (xs: t) (ys: t) = - let leq_interval (al, au) (bl, bu) = al >=. bl && au <=. bu in - match xs, ys with - | [], _ -> true - | _, [] -> false - | (xl,xr)::xs', (yl,yr)::ys' -> - if leq_interval (xl,xr) (yl,yr) then - leq xs' ys - else if xr <. yl then - false - else - leq xs ys' - - let join ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let meet ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Meet |> - events_to_intervals - - let to_int = function - | [x] -> IArith.to_int x - | _ -> None - - let zero = [IArith.zero] - let one = [IArith.one] - let top_bool = [IArith.top_bool] - - let not_bool (x:t) = - let is_false x = equal x zero in - let is_true x = equal x one in - if is_true x then zero else if is_false x then one else top_bool - - let to_bool = function - | [(l,u)] when l =. Ints_t.zero && u =. Ints_t.zero -> Some false - | x -> if leq zero x then None else Some true - - let of_bool _ = function true -> one | false -> zero - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm_interval ~suppress_ovwarn ~cast:false ik (x,y) - - let of_int ik (x: int_t) = of_interval ik (x, x) - - let lt ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <. min_y then - of_bool ik true - else if min_x >=. max_y then - of_bool ik false - else - top_bool - - let le ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <=. min_y then - of_bool ik true - else if min_x >. max_y then - of_bool ik false - else - top_bool - - let gt ik x y = not_bool @@ le ik x y - - let ge ik x y = not_bool @@ lt ik x y - - let eq ik x y = match x, y with - | (a, b)::[], (c, d)::[] when a =. b && c =. d && a =. c -> - one - | _ -> - if is_bot (meet ik x y) then - zero - else - top_bool - - let ne ik x y = not_bool @@ eq ik x y - let interval_to_int i = Interval.to_int (Some i) - let interval_to_bool i = Interval.to_bool (Some i) - - let log f ik (i1, i2) = - match (interval_to_bool i1, interval_to_bool i2) with - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - - let bit f ik (i1, i2) = - match (interval_to_int i1), (interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - - let bitcomp f ik (i1, i2) = - match (interval_to_int i1, interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{overflow=false; underflow=false})) - | _, _ -> (top_of ik,{overflow=false; underflow=false}) - - let logand ik x y = - let interval_logand = bit Ints_t.logand ik in - binop x y interval_logand - - let logor ik x y = - let interval_logor = bit Ints_t.logor ik in - binop x y interval_logor - - let logxor ik x y = - let interval_logxor = bit Ints_t.logxor ik in - binop x y interval_logxor - - let lognot ik x = - let interval_lognot i = - match interval_to_int i with - | Some x -> of_int ik (Ints_t.lognot x) |> fst - | _ -> top_of ik - in - unop x interval_lognot - - let shift_left ik x y = - let interval_shiftleft = bitcomp (fun x y -> Ints_t.shift_left x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftleft - - let shift_right ik x y = - let interval_shiftright = bitcomp (fun x y -> Ints_t.shift_right x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftright - - let c_lognot ik x = - let log1 f ik i1 = - match interval_to_bool i1 with - | Some x -> of_bool ik (f x) - | _ -> top_of ik - in - let interval_lognot = log1 not ik in - unop x interval_lognot - - let c_logand ik x y = - let interval_logand = log (&&) ik in - binop x y interval_logand - - let c_logor ik x y = - let interval_logor = log (||) ik in - binop x y interval_logor - - let add ?no_ov = binary_op_with_norm IArith.add - let sub ?no_ov = binary_op_with_norm IArith.sub - let mul ?no_ov = binary_op_with_norm IArith.mul - let neg ?no_ov = unary_op_with_norm IArith.neg - - let div ?no_ov ik x y = - let rec interval_div x (y1, y2) = begin - let top_of ik = top_of ik |> List.hd in - let is_zero v = v =. Ints_t.zero in - match y1, y2 with - | l, u when is_zero l && is_zero u -> top_of ik (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> interval_div x (Ints_t.one,y2) - | _, u when is_zero u -> interval_div x (y1, Ints_t.(neg one)) - | _ when leq (of_int ik (Ints_t.zero) |> fst) ([(y1,y2)]) -> top_of ik - | _ -> IArith.div x (y1, y2) - end - in binary_op_with_norm interval_div ik x y - - let rem ik x y = - let interval_rem (x, y) = - if Interval.is_top_of ik (Some x) && Interval.is_top_of ik (Some y) then - top_of ik - else - let (xl, xu) = x in let (yl, yu) = y in - let pos x = if x <. Ints_t.zero then Ints_t.neg x else x in - let b = (Ints_t.max (pos yl) (pos yu)) -. Ints_t.one in - let range = if xl >=. Ints_t.zero then (Ints_t.zero, Ints_t.min xu b) else (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit Ints_t.rem ik (x, y)) [range] - in - binop x y interval_rem - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik x = norm_intvs ~cast:true ik x - - (* - narrows down the extremeties of xs if they are equal to boundary values of the ikind with (possibly) narrower values from ys - *) - let narrow ik xs ys = match xs ,ys with - | [], _ -> [] | _ ,[] -> xs - | _, _ -> - let min_xs = minimal xs |> Option.get in - let max_xs = maximal xs |> Option.get in - let min_ys = minimal ys |> Option.get in - let max_ys = maximal ys |> Option.get in - let min_range,max_range = range ik in - let threshold = get_interval_threshold_widening () in - let min = if min_xs =. min_range || threshold && min_ys >. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in - let max = if max_xs =. max_range || threshold && max_ys <. max_xs && IArith.is_upper_threshold max_xs then max_ys else max_xs in - xs - |> (function (_, y)::z -> (min, y)::z | _ -> []) - |> List.rev - |> (function (x, _)::z -> (x, max)::z | _ -> []) - |> List.rev - - (* - 1. partitions the intervals of xs by assigning each of them to the an interval in ys that includes it. - and joins all intervals in xs assigned to the same interval in ys as one interval. - 2. checks for every pair of adjacent pairs whether the pairs did approach (if you compare the intervals from xs and ys) and merges them if it is the case. - 3. checks whether partitions at the extremeties are approaching infinity (and expands them to infinity. in that case) - - The expansion (between a pair of adjacent partitions or at extremeties ) stops at a threshold. - *) - let widen ik xs ys = - let (min_ik,max_ik) = range ik in - let threshold = get_bool "ana.int.interval_threshold_widening" in - let upper_threshold (_,u) = IArith.upper_threshold u max_ik in - let lower_threshold (l,_) = IArith.lower_threshold l min_ik in - (*obtain partitioning of xs intervals according to the ys interval that includes them*) - let rec interval_sets_to_partitions (ik: ikind) (acc : (int_t * int_t) option) (xs: t) (ys: t)= - match xs,ys with - | _, [] -> [] - | [], (y::ys) -> (acc,y):: interval_sets_to_partitions ik None [] ys - | (x::xs), (y::ys) when Interval.leq (Some x) (Some y) -> interval_sets_to_partitions ik (Interval.join ik acc (Some x)) xs (y::ys) - | (x::xs), (y::ys) -> (acc,y) :: interval_sets_to_partitions ik None (x::xs) ys - in - let interval_sets_to_partitions ik xs ys = interval_sets_to_partitions ik None xs ys in - (*merge a pair of adjacent partitions*) - let merge_pair ik (a,b) (c,d) = - let new_a = function - | None -> Some (upper_threshold b, upper_threshold b) - | Some (ax,ay) -> Some (ax, upper_threshold b) - in - let new_c = function - | None -> Some (lower_threshold d, lower_threshold d) - | Some (cx,cy) -> Some (lower_threshold d, cy) - in - if threshold && (lower_threshold d +. Ints_t.one) >. (upper_threshold b) then - [(new_a a,(fst b, upper_threshold b)); (new_c c, (lower_threshold d, snd d))] - else - [(Interval.join ik a c, (Interval.join ik (Some b) (Some d) |> Option.get))] - in - let partitions_are_approaching part_left part_right = match part_left, part_right with - | (Some (_, left_x), (_, left_y)), (Some (right_x, _), (right_y, _)) -> (right_x -. left_x) >. (right_y -. left_y) - | _,_ -> false - in - (*merge all approaching pairs of adjacent partitions*) - let rec merge_list ik = function - | [] -> [] - | x::y::xs when partitions_are_approaching x y -> merge_list ik ((merge_pair ik x y) @ xs) - | x::xs -> x :: merge_list ik xs - in - (*expands left extremity*) - let widen_left = function - | [] -> [] - | (None,(lb,rb))::ts -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (None, (lt,rb))::ts - | (Some (la,ra), (lb,rb))::ts when lb <. la -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (Some (la,ra),(lt,rb))::ts - | x -> x - in - (*expands right extremity*) - let widen_right x = - let map_rightmost = function - | [] -> [] - | (None,(lb,rb))::ts -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (None, (lb,ut))::ts - | (Some (la,ra), (lb,rb))::ts when ra <. rb -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (Some (la,ra),(lb,ut))::ts - | x -> x - in - List.rev x |> map_rightmost |> List.rev - in - interval_sets_to_partitions ik xs ys |> merge_list ik |> widen_left |> widen_right |> List.map snd - - let starting ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (fst (range ik), n) - - let invariant_ikind e ik xs = - List.map (fun x -> Interval.invariant_ikind e ik (Some x)) xs |> - let open Invariant in List.fold_left (||) (bot ()) - - let modulo n k = - let result = Ints_t.rem n k in - if result >=. Ints_t.zero then result - else result +. k - - let refine_with_congruence ik (intvs: t) (cong: (int_t * int_t ) option): t = - let refine_with_congruence_interval ik (cong : (int_t * int_t ) option) (intv : (int_t * int_t ) option): t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if m =. Ints_t.zero && (c <. x || c >. y) then [] - else if m =. Ints_t.zero then - [(c, c)] - else - let (min_ik, max_ik) = range ik in - let rcx = - if x =. min_ik then x else - x +. (modulo (c -. x) (Ints_t.abs m)) in - let lcy = - if y =. max_ik then y else - y -. (modulo (y -. c) (Ints_t.abs m)) in - if rcx >. lcy then [] - else if rcx =. lcy then norm_interval ik (rcx, rcx) |> fst - else norm_interval ik (rcx, lcy) |> fst - | _ -> [] - in - List.concat_map (fun x -> refine_with_congruence_interval ik cong (Some x)) intvs - - let refine_with_interval ik xs = function None -> [] | Some (a,b) -> meet ik xs [(a,b)] - - let refine_with_incl_list ik intvs = function - | None -> intvs - | Some xs -> meet ik intvs (List.map (fun x -> (x,x)) xs) - - let excl_range_to_intervalset (ik: ikind) ((min, max): int_t * int_t) (excl: int_t): t = - let intv1 = (min, excl -. Ints_t.one) in - let intv2 = (excl +. Ints_t.one, max) in - norm_intvs ik ~suppress_ovwarn:true [intv1 ; intv2] |> fst - - let of_excl_list ik (excls: int_t list) = - let excl_list = List.map (excl_range_to_intervalset ik (range ik)) excls in - let res = List.fold_left (meet ik) (top_of ik) excl_list in - res - - let refine_with_excl_list ik (intv : t) = function - | None -> intv - | Some (xs, range) -> - let excl_to_intervalset (ik: ikind) ((rl, rh): (int64 * int64)) (excl: int_t): t = - excl_range_to_intervalset ik (Ints_t.of_bigint (Size.min_from_bit_range rl),Ints_t.of_bigint (Size.max_from_bit_range rh)) excl - in - let excl_list = List.map (excl_to_intervalset ik range) xs in - List.fold_left (meet ik) intv excl_list - - let project ik p t = t - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let list_pair_arb = QCheck.small_list pair_arb in - let canonize_randomly_generated_list = (fun x -> norm_intvs ik x |> fst) in - let shrink xs = GobQCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list - in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) canonize_randomly_generated_list list_pair_arb) -end - -module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct - include D - - let add ?no_ov ik x y = fst @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = fst @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = fst @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = fst @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = fst @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = fst @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = fst @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = fst @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = fst @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = fst @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = fst @@ D.shift_left ik x y - - let shift_right ik x y = fst @@ D.shift_right ik x y -end - -module IntIkind = struct let ikind () = Cil.IInt end -module Interval = IntervalFunctor (IntOps.BigIntOps) -module Interval32 = IntDomWithDefaultIkind (IntDomLifter (SOverflowUnlifter (IntervalFunctor (IntOps.Int64Ops)))) (IntIkind) -module IntervalSet = IntervalSetFunctor (IntOps.BigIntOps) -module Integers (Ints_t : IntOps.IntOps): IkindUnawareS with type t = Ints_t.t and type int_t = Ints_t.t = (* no top/bot, order is <= *) -struct - include Printable.Std - let name () = "integers" - type t = Ints_t.t [@@deriving eq, ord, hash] - type int_t = Ints_t.t - let top () = raise Unknown - let bot () = raise Error - let top_of ik = top () - let bot_of ik = bot () - let show (x: Ints_t.t) = Ints_t.to_string x - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - (* is_top and is_bot are never called, but if they were, the Std impl would raise their exception, so we overwrite them: *) - let is_top _ = false - let is_bot _ = false - - let equal_to i x = if i > x then `Neq else `Top - let leq x y = x <= y - let join x y = if Ints_t.compare x y > 0 then x else y - let widen = join - let meet x y = if Ints_t.compare x y > 0 then y else x - let narrow = meet - - let of_bool x = if x then Ints_t.one else Ints_t.zero - let to_bool' x = x <> Ints_t.zero - let to_bool x = Some (to_bool' x) - let of_int x = x - let to_int x = Some x - - let neg = Ints_t.neg - let add = Ints_t.add (* TODO: signed overflow is undefined behavior! *) - let sub = Ints_t.sub - let mul = Ints_t.mul - let div = Ints_t.div - let rem = Ints_t.rem - let lt n1 n2 = of_bool (n1 < n2) - let gt n1 n2 = of_bool (n1 > n2) - let le n1 n2 = of_bool (n1 <= n2) - let ge n1 n2 = of_bool (n1 >= n2) - let eq n1 n2 = of_bool (n1 = n2) - let ne n1 n2 = of_bool (n1 <> n2) - let lognot = Ints_t.lognot - let logand = Ints_t.logand - let logor = Ints_t.logor - let logxor = Ints_t.logxor - let shift_left n1 n2 = Ints_t.shift_left n1 (Ints_t.to_int n2) - let shift_right n1 n2 = Ints_t.shift_right n1 (Ints_t.to_int n2) - let c_lognot n1 = of_bool (not (to_bool' n1)) - let c_logand n1 n2 = of_bool ((to_bool' n1) && (to_bool' n2)) - let c_logor n1 n2 = of_bool ((to_bool' n1) || (to_bool' n2)) - let cast_to ?(suppress_ovwarn=false) ?torg t x = failwith @@ "Cast_to not implemented for " ^ (name ()) ^ "." - let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 (* TODO: use ikind *) - let invariant _ _ = Invariant.none (* TODO *) -end - -module FlatPureIntegers: IkindUnawareS with type t = int64 and type int_t = int64 = (* Integers, but raises Unknown/Error on join/meet *) -struct - include Integers(IntOps.Int64Ops) - let top () = raise Unknown - let bot () = raise Error - let leq = equal - let pretty_diff () (x,y) = Pretty.dprintf "Integer %a instead of %a" pretty x pretty y - let join x y = if equal x y then x else top () - let meet x y = if equal x y then x else bot () -end - -module Flat (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) -struct - type int_t = Base.int_t - include Lattice.FlatConf (struct - include Printable.DefaultConf - let top_name = "Unknown int" - let bot_name = "Error int" - end) (Base) - - let top_of ik = top () - let bot_of ik = bot () - - - let name () = "flat integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ikind x = top_of ikind - let ending ?(suppress_ovwarn=false) ikind x = top_of ikind - let maximal x = None - let minimal x = None - - let lift1 f x = match x with - | `Lifted x -> - (try `Lifted (f x) with Unknown -> `Top | Error -> `Bot) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> - (try `Lifted (f x y) with Unknown -> `Top | Error -> `Bot) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Lift (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) -struct - include Lattice.LiftPO (struct - include Printable.DefaultConf - let top_name = "MaxInt" - let bot_name = "MinInt" - end) (Base) - type int_t = Base.int_t - let top_of ik = top () - let bot_of ik = bot () - include StdTop (struct type nonrec t = t let top_of = top_of end) - - let name () = "lifted integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let lift1 f x = match x with - | `Lifted x -> `Lifted (f x) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> `Lifted (f x y) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Flattened = Flat (Integers (IntOps.Int64Ops)) -module Lifted = Lift (Integers (IntOps.Int64Ops)) - -module Reverse (Base: IkindUnawareS) = -struct - include Base - include (Lattice.Reverse (Base) : Lattice.S with type t := Base.t) -end - -module BISet = struct - include SetDomain.Make (IntOps.BigIntOps) - let is_singleton s = cardinal s = 1 -end - -(* The module [Exclusion] constains common functionality about handling of exclusion sets between [DefExc] and [Enums] *) -module Exclusion = -struct - module R = Interval32 - (* We use these types for the functions in this module to make the intended meaning more explicit *) - type t = Exc of BISet.t * Interval32.t - type inc = Inc of BISet.t [@@unboxed] - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.succ (Z.add (Z.neg (min_of_range r)) (max_of_range r)) - - let cardinality_BISet s = - Z.of_int (BISet.cardinal s) - - let leq_excl_incl (Exc (xs, r)) (Inc ys) = - (* For a <= b to hold, the cardinalities must fit, i.e. |a| <= |b|, which implies |min_r, max_r| - |xs| <= |ys|. We check this first. *) - let lower_bound_cardinality_a = Z.sub (cardinality_of_range r) (cardinality_BISet xs) in - let card_b = cardinality_BISet ys in - if Z.compare lower_bound_cardinality_a card_b > 0 then - false - else (* The cardinality did fit, so we check for all elements that are represented by range r, whether they are in (xs union ys) *) - let min_a = min_of_range r in - let max_a = max_of_range r in - GobZ.for_all_range (fun el -> BISet.mem el xs || BISet.mem el ys) (min_a, max_a) - - let leq (Exc (xs, r)) (Exc (ys, s)) = - let min_a, max_a = min_of_range r, max_of_range r in - let excluded_check = BISet.for_all (fun y -> BISet.mem y xs || Z.compare y min_a < 0 || Z.compare y max_a > 0) ys in (* if true, then the values ys, that are not in b, also do not occur in a *) - if not excluded_check - then false - else begin (* Check whether all elements that are in the range r, but not in s, are in xs, i.e. excluded. *) - if R.leq r s then true - else begin if Z.compare (cardinality_BISet xs) (Z.sub (cardinality_of_range r) (cardinality_of_range s)) >= 0 (* Check whether the number of excluded elements in a is as least as big as |min_r, max_r| - |min_s, max_s| *) - then - let min_b, max_b = min_of_range s, max_of_range s in - let leq1 = (* check whether the elements in [r_l; s_l-1] are all in xs, i.e. excluded *) - if Z.compare min_a min_b < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (min_a, Z.pred min_b) - else - true - in - let leq2 () = (* check whether the elements in [s_u+1; r_u] are all in xs, i.e. excluded *) - if Z.compare max_b max_a < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (Z.succ max_b, max_a) - else - true - in - leq1 && (leq2 ()) - else - false - end - end -end module DefExc : S with type int_t = Z.t = (* definite or set of excluded values *) struct @@ -2375,35 +479,3 @@ struct let project ik p t = t end - -module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct - - include D - - let lift v = (v, {overflow=false; underflow=false}) - - let add ?no_ov ik x y = lift @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = lift @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = lift @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = lift @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = lift @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = lift @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = lift @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = lift @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = lift @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = lift @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = lift @@ D.shift_left ik x y - - let shift_right ik x y = lift @@ D.shift_right ik x y - -end From a35c289d246d2fc55ea993f53ded147db91c0ae1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:03:24 +0300 Subject: [PATCH 110/157] Remove DefExc from IntDomain0 --- src/cdomain/value/cdomains/intDomain0.ml | 479 ----------------------- 1 file changed, 479 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/intDomain0.ml index 1cda533c55..0bcfa6ae44 100644 --- a/src/cdomain/value/cdomains/intDomain0.ml +++ b/src/cdomain/value/cdomains/intDomain0.ml @@ -1897,485 +1897,6 @@ struct end end -module DefExc : S with type int_t = Z.t = (* definite or set of excluded values *) -struct - module S = BISet - module R = Interval32 (* range for exclusion *) - - (* Ikind used for intervals representing the domain *) - let range_ikind = Cil.IInt - let size t = R.of_interval range_ikind (let a,b = Size.bits_i64 t in Int64.neg a,b) - - - type t = [ - | `Excluded of S.t * R.t - | `Definite of Z.t - | `Bot - ] [@@deriving eq, ord, hash] - type int_t = Z.t - let name () = "def_exc" - - - let top_range = R.of_interval range_ikind (-99L, 99L) (* Since there is no top ikind we use a range that includes both ILongLong [-63,63] and IULongLong [0,64]. Only needed for intermediate range computation on longs. Correct range is set by cast. *) - let top () = `Excluded (S.empty (), top_range) - let bot () = `Bot - let top_of ik = `Excluded (S.empty (), size ik) - let bot_of ik = bot () - - let show x = - let short_size x = "("^R.show x^")" in - match x with - | `Bot -> "Error int" - | `Definite x -> Z.to_string x - (* Print the empty exclusion as if it was a distinct top element: *) - | `Excluded (s,l) when S.is_empty s -> "Unknown int" ^ short_size l - (* Prepend the exclusion sets with something: *) - | `Excluded (s,l) -> "Not " ^ S.show s ^ short_size l - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let maximal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.max_of_range r) - | `Bot -> None - - let minimal = function - | `Definite x -> Some x - | `Excluded (s,r) -> Some (Exclusion.min_of_range r) - | `Bot -> None - - let in_range r i = - if Z.compare i Z.zero < 0 then - let lowerb = Exclusion.min_of_range r in - Z.compare lowerb i <= 0 - else - let upperb = Exclusion.max_of_range r in - Z.compare i upperb <= 0 - - let is_top x = x = top () - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Definite x -> if i = x then `Eq else `Neq - | `Excluded (s,r) -> if S.mem i s then `Neq else `Top - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik = function - | `Excluded (s,r) -> - let r' = size ik in - if R.leq r r' then (* upcast -> no change *) - `Excluded (s, r) - else if ik = IBool then (* downcast to bool *) - if S.mem Z.zero s then - `Definite Z.one - else - `Excluded (S.empty(), r') - else - (* downcast: may overflow *) - (* let s' = S.map (Size.cast ik) s in *) - (* We want to filter out all i in s' where (t)x with x in r could be i. *) - (* Since this is hard to compute, we just keep all i in s' which overflowed, since those are safe - all i which did not overflow may now be possible due to overflow of r. *) - (* S.diff s' s, r' *) - (* The above is needed for test 21/03, but not sound! See example https://github.com/goblint/analyzer/pull/95#discussion_r483023140 *) - `Excluded (S.empty (), r') - | `Definite x -> `Definite (Size.cast ik x) - | `Bot -> `Bot - - (* Wraps definite values and excluded values according to the ikind. - * For an `Excluded s,r , assumes that r is already an overapproximation of the range of possible values. - * r might be larger than the possible range of this type; the range of the returned `Excluded set will be within the bounds of the ikind. - *) - let norm ik v = - match v with - | `Excluded (s, r) -> - let possibly_overflowed = not (R.leq r (size ik)) || not (S.for_all (in_range (size ik)) s) in - (* If no overflow occurred, just return x *) - if not possibly_overflowed then ( - v - ) - (* Else, if an overflow might have occurred but we should just ignore it *) - else if should_ignore_overflow ik then ( - let r = size ik in - (* filter out excluded elements that are not in the range *) - let mapped_excl = S.filter (in_range r) s in - `Excluded (mapped_excl, r) - ) - (* Else, if an overflow occurred that we should not treat with wrap-around, go to top *) - else if not (should_wrap ik) then ( - top_of ik - ) else ( - (* Else an overflow occurred that we should treat with wrap-around *) - let r = size ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - let mapped_excl = S.map (fun excl -> Size.cast ik excl) s in - match ik with - | IBool -> - begin match S.mem Z.zero mapped_excl, S.mem Z.one mapped_excl with - | false, false -> `Excluded (mapped_excl, r) (* Not {} -> Not {} *) - | true, false -> `Definite Z.one (* Not {0} -> 1 *) - | false, true -> `Definite Z.zero (* Not {1} -> 0 *) - | true, true -> `Bot (* Not {0, 1} -> bot *) - end - | ik -> - `Excluded (mapped_excl, r) - ) - | `Definite x -> - let min, max = Size.range ik in - (* Perform a wrap-around for unsigned values and for signed values (if configured). *) - if should_wrap ik then ( - cast_to ik v - ) - else if Z.compare min x <= 0 && Z.compare x max <= 0 then ( - v - ) - else if should_ignore_overflow ik then ( - M.warn ~category:M.Category.Integer.overflow "DefExc: Value was outside of range, indicating overflow, but 'sem.int.signed_overflow' is 'assume_none' -> Returned Bot"; - `Bot - ) - else ( - top_of ik - ) - | `Bot -> `Bot - - let leq x y = match (x,y) with - (* `Bot <= x is always true *) - | `Bot, _ -> true - (* Anything except bot <= bot is always false *) - | _, `Bot -> false - (* Two known values are leq whenever equal *) - | `Definite (x: int_t), `Definite y -> x = y - (* A definite value is leq all exclusion sets that don't contain it *) - | `Definite x, `Excluded (s,r) -> in_range r x && not (S.mem x s) - (* No finite exclusion set can be leq than a definite value *) - | `Excluded (xs, xr), `Definite d -> - Exclusion.(leq_excl_incl (Exc (xs, xr)) (Inc (S.singleton d))) - | `Excluded (xs,xr), `Excluded (ys,yr) -> - Exclusion.(leq (Exc (xs,xr)) (Exc (ys, yr))) - - let join' ?range ik x y = - match (x,y) with - (* The least upper bound with the bottom element: *) - | `Bot, x -> x - | x, `Bot -> x - (* The case for two known values: *) - | `Definite (x: int_t), `Definite y -> - (* If they're equal, it's just THAT value *) - if x = y then `Definite x - (* Unless one of them is zero, we can exclude it: *) - else - let a,b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval range_ikind a) (R.of_interval range_ikind b) in - `Excluded ((if Z.equal x Z.zero || Z.equal y Z.zero then S.empty () else S.singleton Z.zero), r) - (* A known value and an exclusion set... the definite value should no - * longer be excluded: *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> - if not (in_range r x) then - let a = R.of_interval range_ikind (Size.min_range_sign_agnostic x) in - `Excluded (S.remove x s, R.join a r) - else - `Excluded (S.remove x s, r) - (* For two exclusion sets, only their intersection can be excluded: *) - | `Excluded (x,wx), `Excluded (y,wy) -> `Excluded (S.inter x y, range |? R.join wx wy) - - let join ik = join' ik - - - let widen ik x y = - if get_def_exc_widen_by_join () then - join' ik x y - else if equal x y then - x - else - join' ~range:(size ik) ik x y - - - let meet ik x y = - match (x,y) with - (* Greatest LOWER bound with the least element is trivial: *) - | `Bot, _ -> `Bot - | _, `Bot -> `Bot - (* Definite elements are either equal or the glb is bottom *) - | `Definite x, `Definite y -> if x = y then `Definite x else `Bot - (* The glb of a definite element and an exclusion set is either bottom or - * just the element itself, if it isn't in the exclusion set *) - | `Excluded (s,r), `Definite x - | `Definite x, `Excluded (s,r) -> if S.mem x s || not (in_range r x) then `Bot else `Definite x - (* The greatest lower bound of two exclusion sets is their union, this is - * just DeMorgans Law *) - | `Excluded (x,r1), `Excluded (y,r2) -> - let r' = R.meet r1 r2 in - let s' = S.union x y |> S.filter (in_range r') in - `Excluded (s', r') - - let narrow ik x y = x - - let of_int ik x = norm ik @@ `Definite x - let to_int x = match x with - | `Definite x -> Some x - | _ -> None - - let from_excl ikind (s: S.t) = norm ikind @@ `Excluded (s, size ikind) - - let of_bool_cmp ik x = of_int ik (if x then Z.one else Z.zero) - let of_bool = of_bool_cmp - let to_bool x = - match x with - | `Definite x -> Some (IntOps.BigIntOps.to_bool x) - | `Excluded (s,r) when S.mem Z.zero s -> Some true - | _ -> None - let top_bool = `Excluded (S.empty (), R.of_interval range_ikind (0L, 1L)) - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = - if Z.compare x y = 0 then - of_int ik x - else - let a, b = Size.min_range_sign_agnostic x, Size.min_range_sign_agnostic y in - let r = R.join (R.of_interval ~suppress_ovwarn range_ikind a) (R.of_interval ~suppress_ovwarn range_ikind b) in - let ex = if Z.gt x Z.zero || Z.lt y Z.zero then S.singleton Z.zero else S.empty () in - norm ik @@ (`Excluded (ex, r)) - - let starting ?(suppress_ovwarn=false) ikind x = - let _,u_ik = Size.range ikind in - of_interval ~suppress_ovwarn ikind (x, u_ik) - - let ending ?(suppress_ovwarn=false) ikind x = - let l_ik,_ = Size.range ikind in - of_interval ~suppress_ovwarn ikind (l_ik, x) - - let of_excl_list t l = - let r = size t in (* elements in l are excluded from the full range of t! *) - `Excluded (List.fold_right S.add l (S.empty ()), r) - let is_excl_list l = match l with `Excluded _ -> true | _ -> false - let to_excl_list (x:t) = match x with - | `Definite _ -> None - | `Excluded (s,r) -> Some (S.elements s, (Option.get (R.minimal r), Option.get (R.maximal r))) - | `Bot -> None - - let to_incl_list x = match x with - | `Definite x -> Some [x] - | `Excluded _ -> None - | `Bot -> None - - let apply_range f r = (* apply f to the min/max of the old range r to get a new range *) - (* If the Int64 might overflow on us during computation, we instead go to top_range *) - match R.minimal r, R.maximal r with - | _ -> - let rf m = (size % Size.min_for % f) (m r) in - let r1, r2 = rf Exclusion.min_of_range, rf Exclusion.max_of_range in - R.join r1 r2 - - (* Default behaviour for unary operators, simply maps the function to the - * DefExc data structure. *) - let lift1 f ik x = norm ik @@ match x with - | `Excluded (s,r) -> - let s' = S.map f s in - `Excluded (s', apply_range f r) - | `Definite x -> `Definite (f x) - | `Bot -> `Bot - - let lift2 f ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite _ - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (f x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - (* Default behaviour for binary operators that are injective in either - * argument, so that Exclusion Sets can be used: *) - let lift2_inj f ik x y = - let def_exc f x s r = `Excluded (S.map (f x) s, apply_range (f x) r) in - norm ik @@ - match x,y with - (* If both are exclusion sets, there isn't anything we can do: *) - | `Excluded _, `Excluded _ -> top () - (* A definite value should be applied to all members of the exclusion set *) - | `Definite x, `Excluded (s,r) -> def_exc f x s r - (* Same thing here, but we should flip the operator to map it properly *) - | `Excluded (s,r), `Definite x -> def_exc (Batteries.flip f) x s r - (* The good case: *) - | `Definite x, `Definite y -> `Definite (f x y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The equality check: *) - let eq ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x equal to an exclusion set, if it is a member then NO otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt false else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt false else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x = y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - (* The inequality check: *) - let ne ik x y = match x,y with - (* Not much to do with two exclusion sets: *) - | `Excluded _, `Excluded _ -> top () - (* Is x unequal to an exclusion set, if it is a member then Yes otherwise we - * don't know: *) - | `Definite x, `Excluded (s,r) -> if S.mem x s then of_bool IInt true else top () - | `Excluded (s,r), `Definite x -> if S.mem x s then of_bool IInt true else top () - (* The good case: *) - | `Definite x, `Definite y -> of_bool IInt (x <> y) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - - let neg ?no_ov ik (x :t) = norm ik @@ lift1 Z.neg ik x - let add ?no_ov ik x y = norm ik @@ lift2_inj Z.add ik x y - - let sub ?no_ov ik x y = norm ik @@ lift2_inj Z.sub ik x y - let mul ?no_ov ik x y = norm ik @@ match x, y with - | `Definite z, (`Excluded _ | `Definite _) when Z.equal z Z.zero -> x - | (`Excluded _ | `Definite _), `Definite z when Z.equal z Z.zero -> y - | `Definite a, `Excluded (s,r) - (* Integer multiplication with even numbers is not injective. *) - (* Thus we cannot exclude the values to which the exclusion set would be mapped to. *) - | `Excluded (s,r),`Definite a when Z.equal (Z.rem a (Z.of_int 2)) Z.zero -> `Excluded (S.empty (), apply_range (Z.mul a) r) - | _ -> lift2_inj Z.mul ik x y - let div ?no_ov ik x y = lift2 Z.div ik x y - let rem ik x y = lift2 Z.rem ik x y - - (* Comparison handling copied from Enums. *) - let handle_bot x y f = match x, y with - | `Bot, `Bot -> `Bot - | `Bot, _ - | _, `Bot -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> f () - - let lt ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 < 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 >= 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let gt ik x y = lt ik y x - - let le ik x y = - handle_bot x y (fun () -> - match minimal x, maximal x, minimal y, maximal y with - | _, Some x2, Some y1, _ when Z.compare x2 y1 <= 0 -> of_bool ik true - | Some x1, _, _, Some y2 when Z.compare x1 y2 > 0 -> of_bool ik false - | _, _, _, _ -> top_bool) - - let ge ik x y = le ik y x - - let lognot = lift1 Z.lognot - - let logand ik x y = norm ik (match x,y with - (* We don't bother with exclusion sets: *) - | `Excluded _, `Definite i -> - (* Except in two special cases *) - if Z.equal i Z.zero then - `Definite Z.zero - else if Z.equal i Z.one then - of_interval IBool (Z.zero, Z.one) - else - top () - | `Definite _, `Excluded _ - | `Excluded _, `Excluded _ -> top () - (* The good case: *) - | `Definite x, `Definite y -> - (try `Definite (Z.logand x y) with | Division_by_zero -> top ()) - | `Bot, `Bot -> `Bot - | _ -> - (* If only one of them is bottom, we raise an exception that eval_rv will catch *) - raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y)))) - - - let logor = lift2 Z.logor - let logxor = lift2 Z.logxor - - let shift (shift_op: int_t -> int -> int_t) (ik: Cil.ikind) (x: t) (y: t) = - (* BigInt only accepts int as second argument for shifts; perform conversion here *) - let shift_op_big_int a (b: int_t) = - let (b : int) = Z.to_int b in - shift_op a b - in - (* If one of the parameters of the shift is negative, the result is undefined *) - let is_negative = GobOption.for_all (fun x -> Z.lt x Z.zero) in - if is_negative (minimal x) || is_negative (minimal y) then - top_of ik - else - norm ik @@ lift2 shift_op_big_int ik x y - - let shift_left = - shift Z.shift_left - - let shift_right = - shift Z.shift_right - (* TODO: lift does not treat Not {0} as true. *) - let c_logand ik x y = - match to_bool x, to_bool y with - | Some false, _ - | _, Some false -> - of_bool ik false - | _, _ -> - lift2 IntOps.BigIntOps.c_logand ik x y - let c_logor ik x y = - match to_bool x, to_bool y with - | Some true, _ - | _, Some true -> - of_bool ik true - | _, _ -> - lift2 IntOps.BigIntOps.c_logor ik x y - let c_lognot ik = eq ik (of_int ik Z.zero) - - let invariant_ikind e ik (x:t) = - match x with - | `Definite x -> - IntInvariant.of_int e ik x - | `Excluded (s, r) -> - (* Emit range invariant if tighter than ikind bounds. - This can be more precise than interval, which has been widened. *) - let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let ri = IntInvariant.of_interval e ik (rmin, rmax) in - let si = IntInvariant.of_excl_list e ik (S.elements s) in - Invariant.(ri && si) - | `Bot -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - let excluded s = from_excl ik s in - let definite x = of_int ik x in - let shrink = function - | `Excluded (s, _) -> GobQCheck.shrink (S.arbitrary ()) s >|= excluded (* S TODO: possibly shrink excluded to definite *) - | `Definite x -> (return `Bot) <+> (GobQCheck.shrink (IntOps.BigIntOps.arbitrary ()) x >|= definite) - | `Bot -> empty - in - QCheck.frequency ~shrink ~print:show [ - 20, QCheck.map excluded (S.arbitrary ()); - 10, QCheck.map definite (IntOps.BigIntOps.arbitrary ()); - 1, QCheck.always `Bot - ] (* S TODO: decide frequencies *) - - let refine_with_congruence ik a b = a - let refine_with_interval ik a b = match a, b with - | x, Some(i) -> meet ik x (of_interval ik i) - | _ -> a - let refine_with_excl_list ik a b = match a, b with - | `Excluded (s, r), Some(ls, _) -> meet ik (`Excluded (s, r)) (of_excl_list ik ls) (* TODO: refine with excl range? *) - | _ -> a - let refine_with_incl_list ik a b = a - - let project ik p t = t -end - module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct include D From da3f5367d01bc71af446ba0a456307d69c68ed21 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:06:25 +0300 Subject: [PATCH 111/157] Rename IntDomain0 -> IntervalSetDomain for split --- .../value/cdomains/{intDomain0.ml => int/intervalSetDomain.ml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/cdomain/value/cdomains/{intDomain0.ml => int/intervalSetDomain.ml} (100%) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/int/intervalSetDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/intDomain0.ml rename to src/cdomain/value/cdomains/int/intervalSetDomain.ml From e0ff2239a0323c62dda30a6617ee176bb8c1abba Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:06:48 +0300 Subject: [PATCH 112/157] Remove non-IntervalSetDomain parts --- .../value/cdomains/int/intervalSetDomain.ml | 1395 +---------------- 1 file changed, 1 insertion(+), 1394 deletions(-) diff --git a/src/cdomain/value/cdomains/int/intervalSetDomain.ml b/src/cdomain/value/cdomains/int/intervalSetDomain.ml index 0bcfa6ae44..20d647ce62 100644 --- a/src/cdomain/value/cdomains/int/intervalSetDomain.ml +++ b/src/cdomain/value/cdomains/int/intervalSetDomain.ml @@ -1,1051 +1,5 @@ -open GobConfig -open GoblintCil -open Pretty -open PrecisionUtil - -module M = Messages - -let (%) = Batteries.(%) -let (|?) = Batteries.(|?) - -exception IncompatibleIKinds of string -exception Unknown -exception Error -exception ArithmeticOnIntegerBot of string - - - - -(** Define records that hold mutable variables representing different Configuration values. - * These values are used to keep track of whether or not the corresponding Config values are en-/disabled *) -type ana_int_config_values = { - mutable interval_threshold_widening : bool option; - mutable interval_narrow_by_meet : bool option; - mutable def_exc_widen_by_join : bool option; - mutable interval_threshold_widening_constants : string option; - mutable refinement : string option; -} - -let ana_int_config: ana_int_config_values = { - interval_threshold_widening = None; - interval_narrow_by_meet = None; - def_exc_widen_by_join = None; - interval_threshold_widening_constants = None; - refinement = None; -} - -let get_interval_threshold_widening () = - if ana_int_config.interval_threshold_widening = None then - ana_int_config.interval_threshold_widening <- Some (get_bool "ana.int.interval_threshold_widening"); - Option.get ana_int_config.interval_threshold_widening - -let get_interval_narrow_by_meet () = - if ana_int_config.interval_narrow_by_meet = None then - ana_int_config.interval_narrow_by_meet <- Some (get_bool "ana.int.interval_narrow_by_meet"); - Option.get ana_int_config.interval_narrow_by_meet - -let get_def_exc_widen_by_join () = - if ana_int_config.def_exc_widen_by_join = None then - ana_int_config.def_exc_widen_by_join <- Some (get_bool "ana.int.def_exc_widen_by_join"); - Option.get ana_int_config.def_exc_widen_by_join - -let get_interval_threshold_widening_constants () = - if ana_int_config.interval_threshold_widening_constants = None then - ana_int_config.interval_threshold_widening_constants <- Some (get_string "ana.int.interval_threshold_widening_constants"); - Option.get ana_int_config.interval_threshold_widening_constants - -let get_refinement () = - if ana_int_config.refinement = None then - ana_int_config.refinement <- Some (get_string "ana.int.refinement"); - Option.get ana_int_config.refinement - - - -(** Whether for a given ikind, we should compute with wrap-around arithmetic. - * Always for unsigned types, for signed types if 'sem.int.signed_overflow' is 'assume_wraparound' *) -let should_wrap ik = not (Cil.isSigned ik) || get_string "sem.int.signed_overflow" = "assume_wraparound" - -(** Whether for a given ikind, we should assume there are no overflows. - * Always false for unsigned types, true for signed types if 'sem.int.signed_overflow' is 'assume_none' *) -let should_ignore_overflow ik = Cil.isSigned ik && get_string "sem.int.signed_overflow" = "assume_none" - -let widening_thresholds = ResettableLazy.from_fun WideningThresholds.thresholds -let widening_thresholds_desc = ResettableLazy.from_fun (List.rev % WideningThresholds.thresholds) - -type overflow_info = { overflow: bool; underflow: bool;} - -let set_overflow_flag ~cast ~underflow ~overflow ik = - if !AnalysisState.executing_speculative_computations then - (* Do not produce warnings when the operations are not actually happening in code *) - () - else - let signed = Cil.isSigned ik in - if !AnalysisState.postsolving && signed && not cast then - AnalysisState.svcomp_may_overflow := true; - let sign = if signed then "Signed" else "Unsigned" in - match underflow, overflow with - | true, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190; CWE 191] "%s integer overflow and underflow" sign - | true, false -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 191] "%s integer underflow" sign - | false, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190] "%s integer overflow" sign - | false, false -> assert false - -let reset_lazy () = - ResettableLazy.reset widening_thresholds; - ResettableLazy.reset widening_thresholds_desc; - ana_int_config.interval_threshold_widening <- None; - ana_int_config.interval_narrow_by_meet <- None; - ana_int_config.def_exc_widen_by_join <- None; - ana_int_config.interval_threshold_widening_constants <- None; - ana_int_config.refinement <- None - -module type Arith = -sig - type t - val neg: t -> t - val add: t -> t -> t - val sub: t -> t -> t - val mul: t -> t -> t - val div: t -> t -> t - val rem: t -> t -> t - - val lt: t -> t -> t - val gt: t -> t -> t - val le: t -> t -> t - val ge: t -> t -> t - val eq: t -> t -> t - val ne: t -> t -> t - - val lognot: t -> t - val logand: t -> t -> t - val logor : t -> t -> t - val logxor: t -> t -> t - - val shift_left : t -> t -> t - val shift_right: t -> t -> t - - val c_lognot: t -> t - val c_logand: t -> t -> t - val c_logor : t -> t -> t +open IntDomain0 -end - -module type ArithIkind = -sig - type t - val neg: Cil.ikind -> t -> t - val add: Cil.ikind -> t -> t -> t - val sub: Cil.ikind -> t -> t -> t - val mul: Cil.ikind -> t -> t -> t - val div: Cil.ikind -> t -> t -> t - val rem: Cil.ikind -> t -> t -> t - - val lt: Cil.ikind -> t -> t -> t - val gt: Cil.ikind -> t -> t -> t - val le: Cil.ikind -> t -> t -> t - val ge: Cil.ikind -> t -> t -> t - val eq: Cil.ikind -> t -> t -> t - val ne: Cil.ikind -> t -> t -> t - - val lognot: Cil.ikind -> t -> t - val logand: Cil.ikind -> t -> t -> t - val logor : Cil.ikind -> t -> t -> t - val logxor: Cil.ikind -> t -> t -> t - - val shift_left : Cil.ikind -> t -> t -> t - val shift_right: Cil.ikind -> t -> t -> t - - val c_lognot: Cil.ikind -> t -> t - val c_logand: Cil.ikind -> t -> t -> t - val c_logor : Cil.ikind -> t -> t -> t - -end - -(* Shared functions between S and Z *) -module type B = -sig - include Lattice.S - type int_t - val bot_of: Cil.ikind -> t - val top_of: Cil.ikind -> t - val to_int: t -> int_t option - val equal_to: int_t -> t -> [`Eq | `Neq | `Top] - - val to_bool: t -> bool option - val to_excl_list: t -> (int_t list * (int64 * int64)) option - val of_excl_list: Cil.ikind -> int_t list -> t - val is_excl_list: t -> bool - - val to_incl_list: t -> int_t list option - - val maximal : t -> int_t option - val minimal : t -> int_t option - - val cast_to: ?suppress_ovwarn:bool -> ?torg:Cil.typ -> Cil.ikind -> t -> t -end - -(** Interface of IntDomain implementations that do not take ikinds for arithmetic operations yet. TODO: Should be ported to S in the future. *) -module type IkindUnawareS = -sig - include B - include Arith with type t := t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: int_t -> t - val of_bool: bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val arbitrary: unit -> t QCheck.arbitrary - val invariant: Cil.exp -> t -> Invariant.t -end - -(** Interface of IntDomain implementations taking an ikind for arithmetic operations *) -module type S = -sig - include B - include ArithIkind with type t:= t - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val neg : ?no_ov:bool -> Cil.ikind -> t -> t - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t - - val join: Cil.ikind -> t -> t -> t - val meet: Cil.ikind -> t -> t -> t - val narrow: Cil.ikind -> t -> t -> t - val widen: Cil.ikind -> t -> t -> t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val is_top_of: Cil.ikind -> t -> bool - val invariant_ikind : Cil.exp -> Cil.ikind -> t -> Invariant.t - - val refine_with_congruence: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_interval: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_excl_list: Cil.ikind -> t -> (int_t list * (int64 * int64)) option -> t - val refine_with_incl_list: Cil.ikind -> t -> int_t list option -> t - - val project: Cil.ikind -> int_precision -> t -> t - val arbitrary: Cil.ikind -> t QCheck.arbitrary -end - -module type SOverflow = -sig - - include S - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val neg : ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val of_int : Cil.ikind -> int_t -> t * overflow_info - - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t * overflow_info - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - - val shift_left : Cil.ikind -> t -> t -> t * overflow_info - - val shift_right : Cil.ikind -> t -> t -> t * overflow_info -end - -module type Y = -sig - (* include B *) - include B - include Arith with type t:= t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val is_top_of: Cil.ikind -> t -> bool - - val project: int_precision -> t -> t - val invariant: Cil.exp -> t -> Invariant.t -end - -module type Z = Y with type int_t = Z.t - - -module IntDomLifter (I : S) = -struct - open Cil - type int_t = I.int_t - type t = { v : I.t; ikind : CilType.Ikind.t } [@@deriving eq, ord, hash] - - let ikind {ikind; _} = ikind - - (* Helper functions *) - let check_ikinds x y = if x.ikind <> y.ikind then raise (IncompatibleIKinds (GobPretty.sprintf "ikinds %a and %a are incompatible. Values: %a and %a" CilType.Ikind.pretty x.ikind CilType.Ikind.pretty y.ikind I.pretty x.v I.pretty y.v)) - let lift op x = {x with v = op x.ikind x.v } - (* For logical operations the result is of type int *) - let lift_logical op x = {v = op x.ikind x.v; ikind = Cil.IInt} - let lift2 op x y = check_ikinds x y; {x with v = op x.ikind x.v y.v } - let lift2_cmp op x y = check_ikinds x y; {v = op x.ikind x.v y.v; ikind = Cil.IInt} - - let bot_of ikind = { v = I.bot_of ikind; ikind} - let bot () = failwith "bot () is not implemented for IntDomLifter." - let is_bot x = I.is_bot x.v - let top_of ikind = { v = I.top_of ikind; ikind} - let top () = failwith "top () is not implemented for IntDomLifter." - let is_top x = I.is_top x.v - - (* Leq does not check for ikind, because it is used in invariant with arguments of different type. - TODO: check ikinds here and fix invariant to work with right ikinds *) - let leq x y = I.leq x.v y.v - let join = lift2 I.join - let meet = lift2 I.meet - let widen = lift2 I.widen - let narrow = lift2 I.narrow - - let show x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - "⊤" - else - I.show x.v (* TODO add ikind to output *) - let pretty () x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - Pretty.text "⊤" - else - I.pretty () x.v (* TODO add ikind to output *) - let pretty_diff () (x, y) = I.pretty_diff () (x.v, y.v) (* TODO check ikinds, add them to output *) - let printXml o x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - BatPrintf.fprintf o "\n\n⊤\n\n\n" - else - I.printXml o x.v (* TODO add ikind to output *) - (* This is for debugging *) - let name () = "IntDomLifter(" ^ (I.name ()) ^ ")" - let to_yojson x = I.to_yojson x.v - let invariant e x = - let e' = Cilfacade.mkCast ~e ~newt:(TInt (x.ikind, [])) in - I.invariant_ikind e' x.ikind x.v - let tag x = I.tag x.v - let arbitrary ik = failwith @@ "Arbitrary not implement for " ^ (name ()) ^ "." - let to_int x = I.to_int x.v - let of_int ikind x = { v = I.of_int ikind x; ikind} - let equal_to i x = I.equal_to i x.v - let to_bool x = I.to_bool x.v - let of_bool ikind b = { v = I.of_bool ikind b; ikind} - let to_excl_list x = I.to_excl_list x.v - let of_excl_list ikind is = {v = I.of_excl_list ikind is; ikind} - let is_excl_list x = I.is_excl_list x.v - let to_incl_list x = I.to_incl_list x.v - let of_interval ?(suppress_ovwarn=false) ikind (lb,ub) = {v = I.of_interval ~suppress_ovwarn ikind (lb,ub); ikind} - let of_congruence ikind (c,m) = {v = I.of_congruence ikind (c,m); ikind} - let starting ?(suppress_ovwarn=false) ikind i = {v = I.starting ~suppress_ovwarn ikind i; ikind} - let ending ?(suppress_ovwarn=false) ikind i = {v = I.ending ~suppress_ovwarn ikind i; ikind} - let maximal x = I.maximal x.v - let minimal x = I.minimal x.v - - let neg = lift I.neg - let add = lift2 I.add - let sub = lift2 I.sub - let mul = lift2 I.mul - let div = lift2 I.div - let rem = lift2 I.rem - let lt = lift2_cmp I.lt - let gt = lift2_cmp I.gt - let le = lift2_cmp I.le - let ge = lift2_cmp I.ge - let eq = lift2_cmp I.eq - let ne = lift2_cmp I.ne - let lognot = lift I.lognot - let logand = lift2 I.logand - let logor = lift2 I.logor - let logxor = lift2 I.logxor - let shift_left x y = {x with v = I.shift_left x.ikind x.v y.v } (* TODO check ikinds*) - let shift_right x y = {x with v = I.shift_right x.ikind x.v y.v } (* TODO check ikinds*) - let c_lognot = lift_logical I.c_lognot - let c_logand = lift2 I.c_logand - let c_logor = lift2 I.c_logor - - let cast_to ?(suppress_ovwarn=false) ?torg ikind x = {v = I.cast_to ~suppress_ovwarn ~torg:(TInt(x.ikind,[])) ikind x.v; ikind} - - let is_top_of ik x = ik = x.ikind && I.is_top_of ik x.v - - let relift x = { v = I.relift x.v; ikind = x.ikind } - - let project p v = { v = I.project v.ikind p v.v; ikind = v.ikind } -end - -module type Ikind = -sig - val ikind: unit -> Cil.ikind -end - -module PtrDiffIkind : Ikind = -struct - let ikind = Cilfacade.ptrdiff_ikind -end - -module IntDomWithDefaultIkind (I: Y) (Ik: Ikind) : Y with type t = I.t and type int_t = I.int_t = -struct - include I - let top () = I.top_of (Ik.ikind ()) - let bot () = I.bot_of (Ik.ikind ()) -end - -module Size = struct (* size in bits as int, range as int64 *) - open Cil - let sign x = if Z.compare x Z.zero < 0 then `Signed else `Unsigned - - let top_typ = TInt (ILongLong, []) - let min_for x = intKindForValue x (sign x = `Unsigned) - let bit = function (* bits needed for representation *) - | IBool -> 1 - | ik -> bytesSizeOfInt ik * 8 - let is_int64_big_int x = Z.fits_int64 x - let card ik = (* cardinality *) - let b = bit ik in - Z.shift_left Z.one b - let bits ik = (* highest bits for neg/pos values *) - let s = bit ik in - if isSigned ik then s-1, s-1 else 0, s - let bits_i64 ik = BatTuple.Tuple2.mapn Int64.of_int (bits ik) - let range ik = - let a,b = bits ik in - let x = if isSigned ik then Z.neg (Z.shift_left Z.one a) (* -2^a *) else Z.zero in - let y = Z.pred (Z.shift_left Z.one b) in (* 2^b - 1 *) - x,y - - let is_cast_injective ~from_type ~to_type = - let (from_min, from_max) = range (Cilfacade.get_ikind from_type) in - let (to_min, to_max) = range (Cilfacade.get_ikind to_type) in - if M.tracing then M.trace "int" "is_cast_injective %a (%a, %a) -> %a (%a, %a)" CilType.Typ.pretty from_type GobZ.pretty from_min GobZ.pretty from_max CilType.Typ.pretty to_type GobZ.pretty to_min GobZ.pretty to_max; - Z.compare to_min from_min <= 0 && Z.compare from_max to_max <= 0 - - let cast t x = (* TODO: overflow is implementation-dependent! *) - if t = IBool then - (* C11 6.3.1.2 Boolean type *) - if Z.equal x Z.zero then Z.zero else Z.one - else - let a,b = range t in - let c = card t in - let y = Z.erem x c in - let y = if Z.gt y b then Z.sub y c - else if Z.lt y a then Z.add y c - else y - in - if M.tracing then M.tracel "cast" "Cast %a to range [%a, %a] (%a) = %a (%s in int64)" GobZ.pretty x GobZ.pretty a GobZ.pretty b GobZ.pretty c GobZ.pretty y (if is_int64_big_int y then "fits" else "does not fit"); - y - - let min_range_sign_agnostic x = - let size ik = - let a,b = bits_i64 ik in - Int64.neg a,b - in - if sign x = `Signed then - size (min_for x) - else - let a, b = size (min_for x) in - if b <= 64L then - let upper_bound_less = Int64.sub b 1L in - let max_one_less = Z.(pred @@ shift_left Z.one (Int64.to_int upper_bound_less)) in - if x <= max_one_less then - a, upper_bound_less - else - a,b - else - a, b - - (* From the number of bits used to represent a positive value, determines the maximal representable value *) - let max_from_bit_range pos_bits = Z.(pred @@ shift_left Z.one (to_int (Z.of_int64 pos_bits))) - - (* From the number of bits used to represent a non-positive value, determines the minimal representable value *) - let min_from_bit_range neg_bits = Z.(if neg_bits = 0L then Z.zero else neg @@ shift_left Z.one (to_int (neg (Z.of_int64 neg_bits)))) - -end - - -module StdTop (B: sig type t val top_of: Cil.ikind -> t end) = struct - open B - (* these should be overwritten for better precision if possible: *) - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ik x = top_of ik - let ending ?(suppress_ovwarn=false) ik x = top_of ik - let maximal x = None - let minimal x = None -end - -module Std (B: sig - type t - val name: unit -> string - val top_of: Cil.ikind -> t - val bot_of: Cil.ikind -> t - val show: t -> string - val equal: t -> t -> bool - end) = struct - include Printable.StdLeaf - let name = B.name (* overwrite the one from Printable.Std *) - open B - let is_top x = failwith "is_top not implemented for IntDomain.Std" - let is_bot x = B.equal x (bot_of Cil.IInt) (* Here we assume that the representation of bottom is independent of the ikind - This may be true for intdomain implementations, but not e.g. for IntDomLifter. *) - let is_top_of ik x = B.equal x (top_of ik) - - (* all output is based on B.show *) - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - let pretty_diff () (x,y) = dprintf "%s: %a instead of %a" (name ()) pretty x pretty y - - include StdTop (B) -end - -(* Textbook interval arithmetic, without any overflow handling etc. *) -module IntervalArith (Ints_t : IntOps.IntOps) = struct - let min4 a b c d = Ints_t.min (Ints_t.min a b) (Ints_t.min c d) - let max4 a b c d = Ints_t.max (Ints_t.max a b) (Ints_t.max c d) - - let mul (x1, x2) (y1, y2) = - let x1y1 = (Ints_t.mul x1 y1) in - let x1y2 = (Ints_t.mul x1 y2) in - let x2y1 = (Ints_t.mul x2 y1) in - let x2y2 = (Ints_t.mul x2 y2) in - (min4 x1y1 x1y2 x2y1 x2y2, max4 x1y1 x1y2 x2y1 x2y2) - - let shift_left (x1,x2) (y1,y2) = - let y1p = Ints_t.shift_left Ints_t.one y1 in - let y2p = Ints_t.shift_left Ints_t.one y2 in - mul (x1, x2) (y1p, y2p) - - let div (x1, x2) (y1, y2) = - let x1y1n = (Ints_t.div x1 y1) in - let x1y2n = (Ints_t.div x1 y2) in - let x2y1n = (Ints_t.div x2 y1) in - let x2y2n = (Ints_t.div x2 y2) in - let x1y1p = (Ints_t.div x1 y1) in - let x1y2p = (Ints_t.div x1 y2) in - let x2y1p = (Ints_t.div x2 y1) in - let x2y2p = (Ints_t.div x2 y2) in - (min4 x1y1n x1y2n x2y1n x2y2n, max4 x1y1p x1y2p x2y1p x2y2p) - - let add (x1, x2) (y1, y2) = (Ints_t.add x1 y1, Ints_t.add x2 y2) - let sub (x1, x2) (y1, y2) = (Ints_t.sub x1 y2, Ints_t.sub x2 y1) - - let neg (x1, x2) = (Ints_t.neg x2, Ints_t.neg x1) - - let one = (Ints_t.one, Ints_t.one) - let zero = (Ints_t.zero, Ints_t.zero) - let top_bool = (Ints_t.zero, Ints_t.one) - - let to_int (x1, x2) = - if Ints_t.equal x1 x2 then Some x1 else None - - let upper_threshold u max_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - let max_ik' = Ints_t.to_bigint max_ik in - let t = List.find_opt (fun x -> Z.compare u x <= 0 && Z.compare x max_ik' <= 0) ts in - BatOption.map_default Ints_t.of_bigint max_ik t - let lower_threshold l min_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - let min_ik' = Ints_t.to_bigint min_ik in - let t = List.find_opt (fun x -> Z.compare l x >= 0 && Z.compare x min_ik' >= 0) ts in - BatOption.map_default Ints_t.of_bigint min_ik t - let is_upper_threshold u = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - List.exists (Z.equal u) ts - let is_lower_threshold l = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - List.exists (Z.equal l) ts -end - -module IntInvariant = -struct - let of_int e ik x = - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.none - - let of_incl_list e ik ps = - match ps with - | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> - assert (List.mem Z.zero ps); - assert (List.mem Z.one ps); - Invariant.none - | [_] when get_bool "witness.invariant.exact" -> - Invariant.none - | _ :: _ :: _ - | [_] | [] -> - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ps - - let of_interval_opt e ik = function - | (Some x1, Some x2) when Z.equal x1 x2 -> - of_int e ik x1 - | x1_opt, x2_opt -> - let (min_ik, max_ik) = Size.range ik in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = - match x1_opt, inexact_type_bounds with - | Some x1, false when Z.equal min_ik x1 -> Invariant.none - | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) - | None, _ -> Invariant.none - in - let i2 = - match x2_opt, inexact_type_bounds with - | Some x2, false when Z.equal x2 max_ik -> Invariant.none - | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) - | None, _ -> Invariant.none - in - Invariant.(i1 && i2) - - let of_interval e ik (x1, x2) = - of_interval_opt e ik (Some x1, Some x2) - - let of_excl_list e ik ns = - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) (Invariant.top ()) ns -end - -module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = -struct - let name () = "intervals" - type int_t = Ints_t.t - type t = (Ints_t.t * Ints_t.t) option [@@deriving eq, ord, hash] - module IArith = IntervalArith (Ints_t) - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - let top_of ik = Some (range ik) - let bot () = None - let bot_of ik = bot () (* TODO: improve *) - - let show = function None -> "bottom" | Some (x,y) -> "["^Ints_t.to_string x^","^Ints_t.to_string y^"]" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) -> - if a = b && b = i then `Eq else if Ints_t.compare a i <= 0 && Ints_t.compare i b <=0 then `Top else `Neq - - let norm ?(suppress_ovwarn=false) ?(cast=false) ik : (t -> t * overflow_info) = function None -> (None, {underflow=false; overflow=false}) | Some (x,y) -> - if Ints_t.compare x y > 0 then - (None,{underflow=false; overflow=false}) - else ( - let (min_ik, max_ik) = range ik in - let underflow = Ints_t.compare min_ik x > 0 in - let overflow = Ints_t.compare max_ik y < 0 in - let ov_info = { underflow = underflow && not suppress_ovwarn; overflow = overflow && not suppress_ovwarn } in - let v = - if underflow || overflow then - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (Ints_t.sub max_ik min_ik) in - let resdiff = Ints_t.abs (Ints_t.sub y x) in - if Ints_t.compare resdiff diff > 0 then - top_of ik - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if Ints_t.compare l u <= 0 then - Some (l, u) - else - (* Interval that wraps around (begins to the right of its end). We can not represent such intervals *) - top_of ik - else if not cast && should_ignore_overflow ik then - let tl, tu = BatOption.get @@ top_of ik in - Some (Ints_t.max tl x, Ints_t.min tu y) - else - top_of ik - else - Some (x,y) - in - (v, ov_info) - ) - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (x1,x2), Some (y1,y2) -> Ints_t.compare x1 y1 >= 0 && Ints_t.compare x2 y2 <= 0 - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.min x1 y1, Ints_t.max x2 y2) |> fst - - let meet ik (x:t) y = - match x, y with - | None, z | z, None -> None - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.max x1 y1, Ints_t.min x2 y2) |> fst - - (* TODO: change to_int signature so it returns a big_int *) - let to_int x = Option.bind x (IArith.to_int) - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm ~suppress_ovwarn ik @@ Some (x,y) - let of_int ik (x: int_t) = of_interval ik (x,x) - let zero = Some IArith.zero - let one = Some IArith.one - let top_bool = Some IArith.top_bool - - let of_bool _ik = function true -> one | false -> zero - let to_bool (a: t) = match a with - | None -> None - | Some (l, u) when Ints_t.compare l Ints_t.zero = 0 && Ints_t.compare u Ints_t.zero = 0 -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (fst (range ik), n) - - (* TODO: change signature of maximal, minimal to return big_int*) - let maximal = function None -> None | Some (x,y) -> Some y - let minimal = function None -> None | Some (x,y) -> Some x - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov t = norm ~cast:true t (* norm does all overflow handling *) - - let widen ik x y = - match x, y with - | None, z | z, None -> z - | Some (l0,u0), Some (l1,u1) -> - let (min_ik, max_ik) = range ik in - let threshold = get_interval_threshold_widening () in - let l2 = - if Ints_t.compare l0 l1 = 0 then l0 - else if threshold then IArith.lower_threshold l1 min_ik - else min_ik - in - let u2 = - if Ints_t.compare u0 u1 = 0 then u0 - else if threshold then IArith.upper_threshold u1 max_ik - else max_ik - in - norm ik @@ Some (l2,u2) |> fst - let widen ik x y = - let r = widen ik x y in - if M.tracing && not (equal x y) then M.tracel "int" "interval widen %a %a -> %a" pretty x pretty y pretty r; - assert (leq x y); (* TODO: remove for performance reasons? *) - r - - let narrow ik x y = - match x, y with - | _,None | None, _ -> None - | Some (x1,x2), Some (y1,y2) -> - let threshold = get_interval_threshold_widening () in - let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 || threshold && Ints_t.compare y1 x1 > 0 && IArith.is_lower_threshold x1 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 || threshold && Ints_t.compare y2 x2 < 0 && IArith.is_upper_threshold x2 then y2 else x2 in - norm ik @@ Some (lr,ur) |> fst - - - let narrow ik x y = - if get_interval_narrow_by_meet () then - meet ik x y - else - narrow ik x y - - let log f ~annihilator ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, _ when x = annihilator -> of_bool ik annihilator - | _, Some y when y = annihilator -> of_bool ik annihilator - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) ~annihilator:true - let c_logand = log (&&) ~annihilator:false - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let bit f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - let bitcomp f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{underflow=false; overflow=false})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let logxor = bit (fun _ik -> Ints_t.logxor) - - let logand ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (Ints_t.logand x y) |> fst with Division_by_zero -> top_of ik) - | _, Some y when Ints_t.equal y Ints_t.zero -> of_int ik Ints_t.zero |> fst - | _, Some y when Ints_t.equal y Ints_t.one -> of_interval ik (Ints_t.zero, Ints_t.one) |> fst - | _ -> top_of ik - - let logor = bit (fun _ik -> Ints_t.logor) - - let bit1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_int i1 with - | Some x -> of_int ik (f ik x) |> fst - | _ -> top_of ik - - let lognot = bit1 (fun _ik -> Ints_t.lognot) - let shift_right = bitcomp (fun _ik x y -> Ints_t.shift_right x (Ints_t.to_int y)) - - let neg ?no_ov ik = function None -> (None,{underflow=false; overflow=false}) | Some x -> norm ik @@ Some (IArith.neg x) - - let binary_op_with_norm ?no_ov op ik x y = match x, y with - | None, None -> (None, {overflow=false; underflow= false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some x, Some y -> norm ik @@ Some (op x y) - - let add ?no_ov = binary_op_with_norm IArith.add - let mul ?no_ov = binary_op_with_norm IArith.mul - let sub ?no_ov = binary_op_with_norm IArith.sub - - let shift_left ik a b = - match is_bot a, is_bot b with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show a) (show b))) - | _ -> - match a, minimal b, maximal b with - | Some a, Some bl, Some bu when (Ints_t.compare bl Ints_t.zero >= 0) -> - (try - let r = IArith.shift_left a (Ints_t.to_int bl, Ints_t.to_int bu) in - norm ik @@ Some r - with Z.Overflow -> (top_of ik,{underflow=false; overflow=true})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let rem ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (xl, xu), Some (yl, yu) -> - if is_top_of ik x && is_top_of ik y then - (* This is needed to preserve soundness also on things bigger than int32 e.g. *) - (* x: 3803957176L -> T in Interval32 *) - (* y: 4209861404L -> T in Interval32 *) - (* x % y: 3803957176L -> T in Interval32 *) - (* T in Interval32 is [-2147483648,2147483647] *) - (* the code below computes [-2147483647,2147483647] for this though which is unsound *) - top_of ik - else - (* If we have definite values, Ints_t.rem will give a definite result. - * Otherwise we meet with a [range] the result can be in. - * This range is [0, min xu b] if x is positive, and [max xl -b, min xu b] if x can be negative. - * The precise bound b is one smaller than the maximum bound. Negative y give the same result as positive. *) - let pos x = if Ints_t.compare x Ints_t.zero < 0 then Ints_t.neg x else x in - let b = Ints_t.sub (Ints_t.max (pos yl) (pos yu)) Ints_t.one in - let range = if Ints_t.compare xl Ints_t.zero>= 0 then Some (Ints_t.zero, Ints_t.min xu b) else Some (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit (fun _ik -> Ints_t.rem) ik x y) range - - let rec div ?no_ov ik x y = - match x, y with - | None, None -> (bot (),{underflow=false; overflow=false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | (Some (x1,x2) as x), (Some (y1,y2) as y) -> - begin - let is_zero v = Ints_t.compare v Ints_t.zero = 0 in - match y1, y2 with - | l, u when is_zero l && is_zero u -> (top_of ik,{underflow=false; overflow=false}) (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> div ik (Some (x1,x2)) (Some (Ints_t.one,y2)) - | _, u when is_zero u -> div ik (Some (x1,x2)) (Some (y1, Ints_t.(neg one))) - | _ when leq (of_int ik (Ints_t.zero) |> fst) (Some (y1,y2)) -> (top_of ik,{underflow=false; overflow=false}) - | _ -> binary_op_with_norm IArith.div ik x y - end - - let ne ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik true - else if Ints_t.compare x2 y1 <= 0 && Ints_t.compare y2 x1 <= 0 then - of_bool ik false - else top_bool - - let eq ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 && Ints_t.compare x2 y1 <= 0 then - of_bool ik true - else if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik false - else top_bool - - let ge ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 then of_bool ik true - else if Ints_t.compare x2 y1 < 0 then of_bool ik false - else top_bool - - let le ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 <= 0 then of_bool ik true - else if Ints_t.compare y2 x1 < 0 then of_bool ik false - else top_bool - - let gt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 then of_bool ik true - else if Ints_t.compare x2 y1 <= 0 then of_bool ik false - else top_bool - - let lt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 < 0 then of_bool ik true - else if Ints_t.compare y2 x1 <= 0 then of_bool ik false - else top_bool - - let invariant_ikind e ik = function - | Some (x1, x2) -> - let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in - IntInvariant.of_interval e ik (x1', x2') - | None -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let shrink = function - | Some (l, u) -> (return None) <+> (GobQCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) - | None -> empty - in - QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) (fun x -> of_interval ik x |> fst ) pair_arb) - - let modulo n k = - let result = Ints_t.rem n k in - if Ints_t.compare result Ints_t.zero >= 0 then result - else Ints_t.add result k - - let refine_with_congruence ik (intv : t) (cong : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if Ints_t.equal m Ints_t.zero && (Ints_t.compare c x < 0 || Ints_t.compare c y > 0) then None - else if Ints_t.equal m Ints_t.zero then - Some (c, c) - else - let (min_ik, max_ik) = range ik in - let rcx = - if Ints_t.equal x min_ik then x else - Ints_t.add x (modulo (Ints_t.sub c x) (Ints_t.abs m)) in - let lcy = - if Ints_t.equal y max_ik then y else - Ints_t.sub y (modulo (Ints_t.sub y c) (Ints_t.abs m)) in - if Ints_t.compare rcx lcy > 0 then None - else if Ints_t.equal rcx lcy then norm ik @@ Some (rcx, rcx) |> fst - else norm ik @@ Some (rcx, lcy) |> fst - | _ -> None - - let refine_with_congruence ik x y = - let refn = refine_with_congruence ik x y in - if M.tracing then M.trace "refine" "int_refine_with_congruence %a %a -> %a" pretty x pretty y pretty refn; - refn - - let refine_with_interval ik a b = meet ik a b - - let refine_with_excl_list ik (intv : t) (excl : (int_t list * (int64 * int64)) option) : t = - match intv, excl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls, (rl, rh)) -> - let rec shrink op b = - let new_b = (op b (Ints_t.of_int(Bool.to_int(BatList.mem_cmp Ints_t.compare b ls)))) in - if not (Ints_t.equal b new_b) then shrink op new_b else new_b - in - let (min_ik, max_ik) = range ik in - let l' = if Ints_t.equal l min_ik then l else shrink Ints_t.add l in - let u' = if Ints_t.equal u max_ik then u else shrink Ints_t.sub u in - let intv' = norm ik @@ Some (l', u') |> fst in - let range = norm ~suppress_ovwarn:true ik (Some (Ints_t.of_bigint (Size.min_from_bit_range rl), Ints_t.of_bigint (Size.max_from_bit_range rh))) |> fst in - meet ik intv' range - - let refine_with_incl_list ik (intv: t) (incl : (int_t list) option) : t = - match intv, incl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls) -> - let rec min m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> min (Some x) xs | Some m -> if Ints_t.compare m x < 0 then min (Some m) xs else min (Some x) xs in - let rec max m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> max (Some x) xs | Some m -> if Ints_t.compare m x > 0 then max (Some m) xs else max (Some x) xs in - match min None ls, max None ls with - | Some m1, Some m2 -> refine_with_interval ik (Some(l, u)) (Some (m1, m2)) - | _, _-> intv - - let project ik p t = t -end (** IntervalSetFunctor that is not just disjunctive completion of intervals, but attempts to be precise for wraparound arithmetic for unsigned types *) module IntervalSetFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) list = @@ -1581,350 +535,3 @@ struct let shrink xs = GobQCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) canonize_randomly_generated_list list_pair_arb) end - -module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct - include D - - let add ?no_ov ik x y = fst @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = fst @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = fst @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = fst @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = fst @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = fst @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = fst @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = fst @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = fst @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = fst @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = fst @@ D.shift_left ik x y - - let shift_right ik x y = fst @@ D.shift_right ik x y -end - -module IntIkind = struct let ikind () = Cil.IInt end -module Interval = IntervalFunctor (IntOps.BigIntOps) -module Interval32 = IntDomWithDefaultIkind (IntDomLifter (SOverflowUnlifter (IntervalFunctor (IntOps.Int64Ops)))) (IntIkind) -module IntervalSet = IntervalSetFunctor (IntOps.BigIntOps) -module Integers (Ints_t : IntOps.IntOps): IkindUnawareS with type t = Ints_t.t and type int_t = Ints_t.t = (* no top/bot, order is <= *) -struct - include Printable.Std - let name () = "integers" - type t = Ints_t.t [@@deriving eq, ord, hash] - type int_t = Ints_t.t - let top () = raise Unknown - let bot () = raise Error - let top_of ik = top () - let bot_of ik = bot () - let show (x: Ints_t.t) = Ints_t.to_string x - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - (* is_top and is_bot are never called, but if they were, the Std impl would raise their exception, so we overwrite them: *) - let is_top _ = false - let is_bot _ = false - - let equal_to i x = if i > x then `Neq else `Top - let leq x y = x <= y - let join x y = if Ints_t.compare x y > 0 then x else y - let widen = join - let meet x y = if Ints_t.compare x y > 0 then y else x - let narrow = meet - - let of_bool x = if x then Ints_t.one else Ints_t.zero - let to_bool' x = x <> Ints_t.zero - let to_bool x = Some (to_bool' x) - let of_int x = x - let to_int x = Some x - - let neg = Ints_t.neg - let add = Ints_t.add (* TODO: signed overflow is undefined behavior! *) - let sub = Ints_t.sub - let mul = Ints_t.mul - let div = Ints_t.div - let rem = Ints_t.rem - let lt n1 n2 = of_bool (n1 < n2) - let gt n1 n2 = of_bool (n1 > n2) - let le n1 n2 = of_bool (n1 <= n2) - let ge n1 n2 = of_bool (n1 >= n2) - let eq n1 n2 = of_bool (n1 = n2) - let ne n1 n2 = of_bool (n1 <> n2) - let lognot = Ints_t.lognot - let logand = Ints_t.logand - let logor = Ints_t.logor - let logxor = Ints_t.logxor - let shift_left n1 n2 = Ints_t.shift_left n1 (Ints_t.to_int n2) - let shift_right n1 n2 = Ints_t.shift_right n1 (Ints_t.to_int n2) - let c_lognot n1 = of_bool (not (to_bool' n1)) - let c_logand n1 n2 = of_bool ((to_bool' n1) && (to_bool' n2)) - let c_logor n1 n2 = of_bool ((to_bool' n1) || (to_bool' n2)) - let cast_to ?(suppress_ovwarn=false) ?torg t x = failwith @@ "Cast_to not implemented for " ^ (name ()) ^ "." - let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 (* TODO: use ikind *) - let invariant _ _ = Invariant.none (* TODO *) -end - -module FlatPureIntegers: IkindUnawareS with type t = int64 and type int_t = int64 = (* Integers, but raises Unknown/Error on join/meet *) -struct - include Integers(IntOps.Int64Ops) - let top () = raise Unknown - let bot () = raise Error - let leq = equal - let pretty_diff () (x,y) = Pretty.dprintf "Integer %a instead of %a" pretty x pretty y - let join x y = if equal x y then x else top () - let meet x y = if equal x y then x else bot () -end - -module Flat (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) -struct - type int_t = Base.int_t - include Lattice.FlatConf (struct - include Printable.DefaultConf - let top_name = "Unknown int" - let bot_name = "Error int" - end) (Base) - - let top_of ik = top () - let bot_of ik = bot () - - - let name () = "flat integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ikind x = top_of ikind - let ending ?(suppress_ovwarn=false) ikind x = top_of ikind - let maximal x = None - let minimal x = None - - let lift1 f x = match x with - | `Lifted x -> - (try `Lifted (f x) with Unknown -> `Top | Error -> `Bot) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> - (try `Lifted (f x y) with Unknown -> `Top | Error -> `Bot) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Lift (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) -struct - include Lattice.LiftPO (struct - include Printable.DefaultConf - let top_name = "MaxInt" - let bot_name = "MinInt" - end) (Base) - type int_t = Base.int_t - let top_of ik = top () - let bot_of ik = bot () - include StdTop (struct type nonrec t = t let top_of = top_of end) - - let name () = "lifted integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let lift1 f x = match x with - | `Lifted x -> `Lifted (f x) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> `Lifted (f x y) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Flattened = Flat (Integers (IntOps.Int64Ops)) -module Lifted = Lift (Integers (IntOps.Int64Ops)) - -module Reverse (Base: IkindUnawareS) = -struct - include Base - include (Lattice.Reverse (Base) : Lattice.S with type t := Base.t) -end - -module BISet = struct - include SetDomain.Make (IntOps.BigIntOps) - let is_singleton s = cardinal s = 1 -end - -(* The module [Exclusion] constains common functionality about handling of exclusion sets between [DefExc] and [Enums] *) -module Exclusion = -struct - module R = Interval32 - (* We use these types for the functions in this module to make the intended meaning more explicit *) - type t = Exc of BISet.t * Interval32.t - type inc = Inc of BISet.t [@@unboxed] - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.succ (Z.add (Z.neg (min_of_range r)) (max_of_range r)) - - let cardinality_BISet s = - Z.of_int (BISet.cardinal s) - - let leq_excl_incl (Exc (xs, r)) (Inc ys) = - (* For a <= b to hold, the cardinalities must fit, i.e. |a| <= |b|, which implies |min_r, max_r| - |xs| <= |ys|. We check this first. *) - let lower_bound_cardinality_a = Z.sub (cardinality_of_range r) (cardinality_BISet xs) in - let card_b = cardinality_BISet ys in - if Z.compare lower_bound_cardinality_a card_b > 0 then - false - else (* The cardinality did fit, so we check for all elements that are represented by range r, whether they are in (xs union ys) *) - let min_a = min_of_range r in - let max_a = max_of_range r in - GobZ.for_all_range (fun el -> BISet.mem el xs || BISet.mem el ys) (min_a, max_a) - - let leq (Exc (xs, r)) (Exc (ys, s)) = - let min_a, max_a = min_of_range r, max_of_range r in - let excluded_check = BISet.for_all (fun y -> BISet.mem y xs || Z.compare y min_a < 0 || Z.compare y max_a > 0) ys in (* if true, then the values ys, that are not in b, also do not occur in a *) - if not excluded_check - then false - else begin (* Check whether all elements that are in the range r, but not in s, are in xs, i.e. excluded. *) - if R.leq r s then true - else begin if Z.compare (cardinality_BISet xs) (Z.sub (cardinality_of_range r) (cardinality_of_range s)) >= 0 (* Check whether the number of excluded elements in a is as least as big as |min_r, max_r| - |min_s, max_s| *) - then - let min_b, max_b = min_of_range s, max_of_range s in - let leq1 = (* check whether the elements in [r_l; s_l-1] are all in xs, i.e. excluded *) - if Z.compare min_a min_b < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (min_a, Z.pred min_b) - else - true - in - let leq2 () = (* check whether the elements in [s_u+1; r_u] are all in xs, i.e. excluded *) - if Z.compare max_b max_a < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (Z.succ max_b, max_a) - else - true - in - leq1 && (leq2 ()) - else - false - end - end -end - -module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct - - include D - - let lift v = (v, {overflow=false; underflow=false}) - - let add ?no_ov ik x y = lift @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = lift @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = lift @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = lift @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = lift @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = lift @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = lift @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = lift @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = lift @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = lift @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = lift @@ D.shift_left ik x y - - let shift_right ik x y = lift @@ D.shift_right ik x y - -end From 3720ea2d30ffef85a3344f7ba99e3f860e15f0ab Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:07:58 +0300 Subject: [PATCH 113/157] Remove IntervalSetFunctor from IntDomain0 --- src/cdomain/value/cdomains/intDomain0.ml | 535 ----------------------- 1 file changed, 535 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/intDomain0.ml index 0bcfa6ae44..833de85ee4 100644 --- a/src/cdomain/value/cdomains/intDomain0.ml +++ b/src/cdomain/value/cdomains/intDomain0.ml @@ -1047,541 +1047,6 @@ struct let project ik p t = t end -(** IntervalSetFunctor that is not just disjunctive completion of intervals, but attempts to be precise for wraparound arithmetic for unsigned types *) -module IntervalSetFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) list = -struct - - module Interval = IntervalFunctor (Ints_t) - module IArith = IntervalArith (Ints_t) - - - let name () = "interval_sets" - - type int_t = Ints_t.t - - let (>.) a b = Ints_t.compare a b > 0 - let (=.) a b = Ints_t.compare a b = 0 - let (<.) a b = Ints_t.compare a b < 0 - let (>=.) a b = Ints_t.compare a b >= 0 - let (<=.) a b = Ints_t.compare a b <= 0 - let (+.) a b = Ints_t.add a b - let (-.) a b = Ints_t.sub a b - - (* - Each domain's element is guaranteed to be in canonical form. That is, each interval contained - inside the set does not overlap with each other and they are not adjacent. - *) - type t = (Ints_t.t * Ints_t.t) list [@@deriving eq, hash, ord] - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - - let top_of ik = [range ik] - - let bot () = [] - - let bot_of ik = bot () - - let show (x: t) = - let show_interval i = Printf.sprintf "[%s, %s]" (Ints_t.to_string (fst i)) (Ints_t.to_string (snd i)) in - List.fold_left (fun acc i -> (show_interval i) :: acc) [] x |> List.rev |> String.concat ", " |> Printf.sprintf "[%s]" - - (* New type definition for the sweeping line algorithm used for implementing join/meet functions. *) - type event = Enter of Ints_t.t | Exit of Ints_t.t - - let unbox_event = function Enter x -> x | Exit x -> x - - let cmp_events x y = - (* Deliberately comparing ints first => Cannot be derived *) - let res = Ints_t.compare (unbox_event x) (unbox_event y) in - if res <> 0 then res - else - begin - match (x, y) with - | (Enter _, Exit _) -> -1 - | (Exit _, Enter _) -> 1 - | (_, _) -> 0 - end - - let interval_set_to_events (xs: t) = - List.concat_map (fun (a, b) -> [Enter a; Exit b]) xs - - let two_interval_sets_to_events (xs: t) (ys: t) = - let xs = interval_set_to_events xs in - let ys = interval_set_to_events ys in - List.merge cmp_events xs ys - - (* Using the sweeping line algorithm, combined_event_list returns a new event list representing the intervals in which at least n intervals in xs overlap - This function is used for both join and meet operations with different parameter n: 1 for join, 2 for meet *) - let combined_event_list lattice_op (xs:event list) = - let l = match lattice_op with `Join -> 1 | `Meet -> 2 in - let aux (interval_count, acc) = function - | Enter x -> (interval_count + 1, if (interval_count + 1) >= l && interval_count < l then (Enter x)::acc else acc) - | Exit x -> (interval_count - 1, if interval_count >= l && (interval_count - 1) < l then (Exit x)::acc else acc) - in - List.fold_left aux (0, []) xs |> snd |> List.rev - - let rec events_to_intervals = function - | [] -> [] - | (Enter x)::(Exit y)::xs -> (x, y)::(events_to_intervals xs) - | _ -> failwith "Invalid events list" - - let remove_empty_gaps (xs: t) = - let aux acc (l, r) = match acc with - | ((a, b)::acc') when (b +. Ints_t.one) >=. l -> (a, r)::acc' - | _ -> (l, r)::acc - in - List.fold_left aux [] xs |> List.rev - - let canonize (xs: t) = - interval_set_to_events xs |> - List.sort cmp_events |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let unop (x: t) op = match x with - | [] -> [] - | _ -> canonize @@ List.concat_map op x - - let binop (x: t) (y: t) op : t = match x, y with - | [], _ -> [] - | _, [] -> [] - | _, _ -> canonize @@ List.concat_map op (BatList.cartesian_product x y) - - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let minimal = function - | [] -> None - | (x, _)::_ -> Some x - - let maximal = function - | [] -> None - | xs -> Some (BatList.last xs |> snd) - - let equal_to_interval i (a, b) = - if a =. b && b =. i then - `Eq - else if a <=. i && i <=. b then - `Top - else - `Neq - - let equal_to i xs = match List.map (equal_to_interval i) xs with - | [] -> failwith "unsupported: equal_to with bottom" - | [`Eq] -> `Eq - | ys when List.for_all ((=) `Neq) ys -> `Neq - | _ -> `Top - - let norm_interval ?(suppress_ovwarn=false) ?(cast=false) ik (x,y) : t*overflow_info = - if x >. y then - ([],{underflow=false; overflow=false}) - else - let (min_ik, max_ik) = range ik in - let underflow = min_ik >. x in - let overflow = max_ik <. y in - let v = if underflow || overflow then - begin - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (max_ik -. min_ik) in - let resdiff = Ints_t.abs (y -. x) in - if resdiff >. diff then - [range ik] - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if l <=. u then - [(l, u)] - else - (* Interval that wraps around (begins to the right of its end). We CAN represent such intervals *) - [(min_ik, u); (l, max_ik)] - else if not cast && should_ignore_overflow ik then - [Ints_t.max min_ik x, Ints_t.min max_ik y] - else - [range ik] - end - else - [(x,y)] - in - if suppress_ovwarn then (v, {underflow=false; overflow=false}) else (v, {underflow; overflow}) - - let norm_intvs ?(suppress_ovwarn=false) ?(cast=false) (ik:ikind) (xs: t) : t*overflow_info = - let res = List.map (norm_interval ~suppress_ovwarn ~cast ik) xs in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let binary_op_with_norm op (ik:ikind) (x: t) (y: t) : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> norm_intvs ik @@ List.concat_map (fun (x,y) -> [op x y]) (BatList.cartesian_product x y) - - let binary_op_with_ovc (x: t) (y: t) op : t*overflow_info = match x, y with - | [], _ -> ([],{overflow=false; underflow=false}) - | _, [] -> ([],{overflow=false; underflow=false}) - | _, _ -> - let res = List.map op (BatList.cartesian_product x y) in - let intvs = List.concat_map fst res in - let underflow = List.exists (fun (_,{underflow; _}) -> underflow) res in - let overflow = List.exists (fun (_,{overflow; _}) -> underflow) res in - (canonize intvs,{underflow; overflow}) - - let unary_op_with_norm op (ik:ikind) (x: t) = match x with - | [] -> ([],{overflow=false; underflow=false}) - | _ -> norm_intvs ik @@ List.concat_map (fun x -> [op x]) x - - let rec leq (xs: t) (ys: t) = - let leq_interval (al, au) (bl, bu) = al >=. bl && au <=. bu in - match xs, ys with - | [], _ -> true - | _, [] -> false - | (xl,xr)::xs', (yl,yr)::ys' -> - if leq_interval (xl,xr) (yl,yr) then - leq xs' ys - else if xr <. yl then - false - else - leq xs ys' - - let join ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Join |> - events_to_intervals |> - remove_empty_gaps - - let meet ik (x: t) (y: t): t = - two_interval_sets_to_events x y |> - combined_event_list `Meet |> - events_to_intervals - - let to_int = function - | [x] -> IArith.to_int x - | _ -> None - - let zero = [IArith.zero] - let one = [IArith.one] - let top_bool = [IArith.top_bool] - - let not_bool (x:t) = - let is_false x = equal x zero in - let is_true x = equal x one in - if is_true x then zero else if is_false x then one else top_bool - - let to_bool = function - | [(l,u)] when l =. Ints_t.zero && u =. Ints_t.zero -> Some false - | x -> if leq zero x then None else Some true - - let of_bool _ = function true -> one | false -> zero - - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm_interval ~suppress_ovwarn ~cast:false ik (x,y) - - let of_int ik (x: int_t) = of_interval ik (x, x) - - let lt ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <. min_y then - of_bool ik true - else if min_x >=. max_y then - of_bool ik false - else - top_bool - - let le ik x y = - match x, y with - | [], [] -> bot_of ik - | [], _ | _, [] -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | _, _ -> - let (max_x, min_y) = (maximal x |> Option.get, minimal y |> Option.get) in - let (min_x, max_y) = (minimal x |> Option.get, maximal y |> Option.get) in - if max_x <=. min_y then - of_bool ik true - else if min_x >. max_y then - of_bool ik false - else - top_bool - - let gt ik x y = not_bool @@ le ik x y - - let ge ik x y = not_bool @@ lt ik x y - - let eq ik x y = match x, y with - | (a, b)::[], (c, d)::[] when a =. b && c =. d && a =. c -> - one - | _ -> - if is_bot (meet ik x y) then - zero - else - top_bool - - let ne ik x y = not_bool @@ eq ik x y - let interval_to_int i = Interval.to_int (Some i) - let interval_to_bool i = Interval.to_bool (Some i) - - let log f ik (i1, i2) = - match (interval_to_bool i1, interval_to_bool i2) with - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - - let bit f ik (i1, i2) = - match (interval_to_int i1), (interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - - let bitcomp f ik (i1, i2) = - match (interval_to_int i1, interval_to_int i2) with - | Some x, Some y -> (try of_int ik (f x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{overflow=false; underflow=false})) - | _, _ -> (top_of ik,{overflow=false; underflow=false}) - - let logand ik x y = - let interval_logand = bit Ints_t.logand ik in - binop x y interval_logand - - let logor ik x y = - let interval_logor = bit Ints_t.logor ik in - binop x y interval_logor - - let logxor ik x y = - let interval_logxor = bit Ints_t.logxor ik in - binop x y interval_logxor - - let lognot ik x = - let interval_lognot i = - match interval_to_int i with - | Some x -> of_int ik (Ints_t.lognot x) |> fst - | _ -> top_of ik - in - unop x interval_lognot - - let shift_left ik x y = - let interval_shiftleft = bitcomp (fun x y -> Ints_t.shift_left x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftleft - - let shift_right ik x y = - let interval_shiftright = bitcomp (fun x y -> Ints_t.shift_right x (Ints_t.to_int y)) ik in - binary_op_with_ovc x y interval_shiftright - - let c_lognot ik x = - let log1 f ik i1 = - match interval_to_bool i1 with - | Some x -> of_bool ik (f x) - | _ -> top_of ik - in - let interval_lognot = log1 not ik in - unop x interval_lognot - - let c_logand ik x y = - let interval_logand = log (&&) ik in - binop x y interval_logand - - let c_logor ik x y = - let interval_logor = log (||) ik in - binop x y interval_logor - - let add ?no_ov = binary_op_with_norm IArith.add - let sub ?no_ov = binary_op_with_norm IArith.sub - let mul ?no_ov = binary_op_with_norm IArith.mul - let neg ?no_ov = unary_op_with_norm IArith.neg - - let div ?no_ov ik x y = - let rec interval_div x (y1, y2) = begin - let top_of ik = top_of ik |> List.hd in - let is_zero v = v =. Ints_t.zero in - match y1, y2 with - | l, u when is_zero l && is_zero u -> top_of ik (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> interval_div x (Ints_t.one,y2) - | _, u when is_zero u -> interval_div x (y1, Ints_t.(neg one)) - | _ when leq (of_int ik (Ints_t.zero) |> fst) ([(y1,y2)]) -> top_of ik - | _ -> IArith.div x (y1, y2) - end - in binary_op_with_norm interval_div ik x y - - let rem ik x y = - let interval_rem (x, y) = - if Interval.is_top_of ik (Some x) && Interval.is_top_of ik (Some y) then - top_of ik - else - let (xl, xu) = x in let (yl, yu) = y in - let pos x = if x <. Ints_t.zero then Ints_t.neg x else x in - let b = (Ints_t.max (pos yl) (pos yu)) -. Ints_t.one in - let range = if xl >=. Ints_t.zero then (Ints_t.zero, Ints_t.min xu b) else (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit Ints_t.rem ik (x, y)) [range] - in - binop x y interval_rem - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov ik x = norm_intvs ~cast:true ik x - - (* - narrows down the extremeties of xs if they are equal to boundary values of the ikind with (possibly) narrower values from ys - *) - let narrow ik xs ys = match xs ,ys with - | [], _ -> [] | _ ,[] -> xs - | _, _ -> - let min_xs = minimal xs |> Option.get in - let max_xs = maximal xs |> Option.get in - let min_ys = minimal ys |> Option.get in - let max_ys = maximal ys |> Option.get in - let min_range,max_range = range ik in - let threshold = get_interval_threshold_widening () in - let min = if min_xs =. min_range || threshold && min_ys >. min_xs && IArith.is_lower_threshold min_xs then min_ys else min_xs in - let max = if max_xs =. max_range || threshold && max_ys <. max_xs && IArith.is_upper_threshold max_xs then max_ys else max_xs in - xs - |> (function (_, y)::z -> (min, y)::z | _ -> []) - |> List.rev - |> (function (x, _)::z -> (x, max)::z | _ -> []) - |> List.rev - - (* - 1. partitions the intervals of xs by assigning each of them to the an interval in ys that includes it. - and joins all intervals in xs assigned to the same interval in ys as one interval. - 2. checks for every pair of adjacent pairs whether the pairs did approach (if you compare the intervals from xs and ys) and merges them if it is the case. - 3. checks whether partitions at the extremeties are approaching infinity (and expands them to infinity. in that case) - - The expansion (between a pair of adjacent partitions or at extremeties ) stops at a threshold. - *) - let widen ik xs ys = - let (min_ik,max_ik) = range ik in - let threshold = get_bool "ana.int.interval_threshold_widening" in - let upper_threshold (_,u) = IArith.upper_threshold u max_ik in - let lower_threshold (l,_) = IArith.lower_threshold l min_ik in - (*obtain partitioning of xs intervals according to the ys interval that includes them*) - let rec interval_sets_to_partitions (ik: ikind) (acc : (int_t * int_t) option) (xs: t) (ys: t)= - match xs,ys with - | _, [] -> [] - | [], (y::ys) -> (acc,y):: interval_sets_to_partitions ik None [] ys - | (x::xs), (y::ys) when Interval.leq (Some x) (Some y) -> interval_sets_to_partitions ik (Interval.join ik acc (Some x)) xs (y::ys) - | (x::xs), (y::ys) -> (acc,y) :: interval_sets_to_partitions ik None (x::xs) ys - in - let interval_sets_to_partitions ik xs ys = interval_sets_to_partitions ik None xs ys in - (*merge a pair of adjacent partitions*) - let merge_pair ik (a,b) (c,d) = - let new_a = function - | None -> Some (upper_threshold b, upper_threshold b) - | Some (ax,ay) -> Some (ax, upper_threshold b) - in - let new_c = function - | None -> Some (lower_threshold d, lower_threshold d) - | Some (cx,cy) -> Some (lower_threshold d, cy) - in - if threshold && (lower_threshold d +. Ints_t.one) >. (upper_threshold b) then - [(new_a a,(fst b, upper_threshold b)); (new_c c, (lower_threshold d, snd d))] - else - [(Interval.join ik a c, (Interval.join ik (Some b) (Some d) |> Option.get))] - in - let partitions_are_approaching part_left part_right = match part_left, part_right with - | (Some (_, left_x), (_, left_y)), (Some (right_x, _), (right_y, _)) -> (right_x -. left_x) >. (right_y -. left_y) - | _,_ -> false - in - (*merge all approaching pairs of adjacent partitions*) - let rec merge_list ik = function - | [] -> [] - | x::y::xs when partitions_are_approaching x y -> merge_list ik ((merge_pair ik x y) @ xs) - | x::xs -> x :: merge_list ik xs - in - (*expands left extremity*) - let widen_left = function - | [] -> [] - | (None,(lb,rb))::ts -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (None, (lt,rb))::ts - | (Some (la,ra), (lb,rb))::ts when lb <. la -> let lt = if threshold then lower_threshold (lb,lb) else min_ik in (Some (la,ra),(lt,rb))::ts - | x -> x - in - (*expands right extremity*) - let widen_right x = - let map_rightmost = function - | [] -> [] - | (None,(lb,rb))::ts -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (None, (lb,ut))::ts - | (Some (la,ra), (lb,rb))::ts when ra <. rb -> let ut = if threshold then upper_threshold (rb,rb) else max_ik in (Some (la,ra),(lb,ut))::ts - | x -> x - in - List.rev x |> map_rightmost |> List.rev - in - interval_sets_to_partitions ik xs ys |> merge_list ik |> widen_left |> widen_right |> List.map snd - - let starting ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = norm_interval ik ~suppress_ovwarn (fst (range ik), n) - - let invariant_ikind e ik xs = - List.map (fun x -> Interval.invariant_ikind e ik (Some x)) xs |> - let open Invariant in List.fold_left (||) (bot ()) - - let modulo n k = - let result = Ints_t.rem n k in - if result >=. Ints_t.zero then result - else result +. k - - let refine_with_congruence ik (intvs: t) (cong: (int_t * int_t ) option): t = - let refine_with_congruence_interval ik (cong : (int_t * int_t ) option) (intv : (int_t * int_t ) option): t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if m =. Ints_t.zero && (c <. x || c >. y) then [] - else if m =. Ints_t.zero then - [(c, c)] - else - let (min_ik, max_ik) = range ik in - let rcx = - if x =. min_ik then x else - x +. (modulo (c -. x) (Ints_t.abs m)) in - let lcy = - if y =. max_ik then y else - y -. (modulo (y -. c) (Ints_t.abs m)) in - if rcx >. lcy then [] - else if rcx =. lcy then norm_interval ik (rcx, rcx) |> fst - else norm_interval ik (rcx, lcy) |> fst - | _ -> [] - in - List.concat_map (fun x -> refine_with_congruence_interval ik cong (Some x)) intvs - - let refine_with_interval ik xs = function None -> [] | Some (a,b) -> meet ik xs [(a,b)] - - let refine_with_incl_list ik intvs = function - | None -> intvs - | Some xs -> meet ik intvs (List.map (fun x -> (x,x)) xs) - - let excl_range_to_intervalset (ik: ikind) ((min, max): int_t * int_t) (excl: int_t): t = - let intv1 = (min, excl -. Ints_t.one) in - let intv2 = (excl +. Ints_t.one, max) in - norm_intvs ik ~suppress_ovwarn:true [intv1 ; intv2] |> fst - - let of_excl_list ik (excls: int_t list) = - let excl_list = List.map (excl_range_to_intervalset ik (range ik)) excls in - let res = List.fold_left (meet ik) (top_of ik) excl_list in - res - - let refine_with_excl_list ik (intv : t) = function - | None -> intv - | Some (xs, range) -> - let excl_to_intervalset (ik: ikind) ((rl, rh): (int64 * int64)) (excl: int_t): t = - excl_range_to_intervalset ik (Ints_t.of_bigint (Size.min_from_bit_range rl),Ints_t.of_bigint (Size.max_from_bit_range rh)) excl - in - let excl_list = List.map (excl_to_intervalset ik range) xs in - List.fold_left (meet ik) intv excl_list - - let project ik p t = t - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let list_pair_arb = QCheck.small_list pair_arb in - let canonize_randomly_generated_list = (fun x -> norm_intvs ik x |> fst) in - let shrink xs = GobQCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list - in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) canonize_randomly_generated_list list_pair_arb) -end - module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct include D From 3b5b9dfdd555f80b2108a15e44c084bb07366023 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:10:16 +0300 Subject: [PATCH 114/157] Rename IntDomain0 -> IntervalDomain for split --- .../value/cdomains/{intDomain0.ml => int/intervalDomain.ml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/cdomain/value/cdomains/{intDomain0.ml => int/intervalDomain.ml} (100%) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/int/intervalDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/intDomain0.ml rename to src/cdomain/value/cdomains/int/intervalDomain.ml From 58725d34b132054a073290f07e6dd59b3049e849 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:10:43 +0300 Subject: [PATCH 115/157] Remove non-IntervalDomain parts --- .../value/cdomains/int/intervalDomain.ml | 983 +----------------- 1 file changed, 1 insertion(+), 982 deletions(-) diff --git a/src/cdomain/value/cdomains/int/intervalDomain.ml b/src/cdomain/value/cdomains/int/intervalDomain.ml index 67d7da2125..eff6bfff3e 100644 --- a/src/cdomain/value/cdomains/int/intervalDomain.ml +++ b/src/cdomain/value/cdomains/int/intervalDomain.ml @@ -1,639 +1,5 @@ -open GobConfig -open GoblintCil -open Pretty -open PrecisionUtil +open IntDomain0 -module M = Messages - -let (%) = Batteries.(%) -let (|?) = Batteries.(|?) - -exception IncompatibleIKinds of string -exception Unknown -exception Error -exception ArithmeticOnIntegerBot of string - - - - -(** Define records that hold mutable variables representing different Configuration values. - * These values are used to keep track of whether or not the corresponding Config values are en-/disabled *) -type ana_int_config_values = { - mutable interval_threshold_widening : bool option; - mutable interval_narrow_by_meet : bool option; - mutable def_exc_widen_by_join : bool option; - mutable interval_threshold_widening_constants : string option; - mutable refinement : string option; -} - -let ana_int_config: ana_int_config_values = { - interval_threshold_widening = None; - interval_narrow_by_meet = None; - def_exc_widen_by_join = None; - interval_threshold_widening_constants = None; - refinement = None; -} - -let get_interval_threshold_widening () = - if ana_int_config.interval_threshold_widening = None then - ana_int_config.interval_threshold_widening <- Some (get_bool "ana.int.interval_threshold_widening"); - Option.get ana_int_config.interval_threshold_widening - -let get_interval_narrow_by_meet () = - if ana_int_config.interval_narrow_by_meet = None then - ana_int_config.interval_narrow_by_meet <- Some (get_bool "ana.int.interval_narrow_by_meet"); - Option.get ana_int_config.interval_narrow_by_meet - -let get_def_exc_widen_by_join () = - if ana_int_config.def_exc_widen_by_join = None then - ana_int_config.def_exc_widen_by_join <- Some (get_bool "ana.int.def_exc_widen_by_join"); - Option.get ana_int_config.def_exc_widen_by_join - -let get_interval_threshold_widening_constants () = - if ana_int_config.interval_threshold_widening_constants = None then - ana_int_config.interval_threshold_widening_constants <- Some (get_string "ana.int.interval_threshold_widening_constants"); - Option.get ana_int_config.interval_threshold_widening_constants - -let get_refinement () = - if ana_int_config.refinement = None then - ana_int_config.refinement <- Some (get_string "ana.int.refinement"); - Option.get ana_int_config.refinement - - - -(** Whether for a given ikind, we should compute with wrap-around arithmetic. - * Always for unsigned types, for signed types if 'sem.int.signed_overflow' is 'assume_wraparound' *) -let should_wrap ik = not (Cil.isSigned ik) || get_string "sem.int.signed_overflow" = "assume_wraparound" - -(** Whether for a given ikind, we should assume there are no overflows. - * Always false for unsigned types, true for signed types if 'sem.int.signed_overflow' is 'assume_none' *) -let should_ignore_overflow ik = Cil.isSigned ik && get_string "sem.int.signed_overflow" = "assume_none" - -let widening_thresholds = ResettableLazy.from_fun WideningThresholds.thresholds -let widening_thresholds_desc = ResettableLazy.from_fun (List.rev % WideningThresholds.thresholds) - -type overflow_info = { overflow: bool; underflow: bool;} - -let set_overflow_flag ~cast ~underflow ~overflow ik = - if !AnalysisState.executing_speculative_computations then - (* Do not produce warnings when the operations are not actually happening in code *) - () - else - let signed = Cil.isSigned ik in - if !AnalysisState.postsolving && signed && not cast then - AnalysisState.svcomp_may_overflow := true; - let sign = if signed then "Signed" else "Unsigned" in - match underflow, overflow with - | true, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190; CWE 191] "%s integer overflow and underflow" sign - | true, false -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 191] "%s integer underflow" sign - | false, true -> - M.warn ~category:M.Category.Integer.overflow ~tags:[CWE 190] "%s integer overflow" sign - | false, false -> assert false - -let reset_lazy () = - ResettableLazy.reset widening_thresholds; - ResettableLazy.reset widening_thresholds_desc; - ana_int_config.interval_threshold_widening <- None; - ana_int_config.interval_narrow_by_meet <- None; - ana_int_config.def_exc_widen_by_join <- None; - ana_int_config.interval_threshold_widening_constants <- None; - ana_int_config.refinement <- None - -module type Arith = -sig - type t - val neg: t -> t - val add: t -> t -> t - val sub: t -> t -> t - val mul: t -> t -> t - val div: t -> t -> t - val rem: t -> t -> t - - val lt: t -> t -> t - val gt: t -> t -> t - val le: t -> t -> t - val ge: t -> t -> t - val eq: t -> t -> t - val ne: t -> t -> t - - val lognot: t -> t - val logand: t -> t -> t - val logor : t -> t -> t - val logxor: t -> t -> t - - val shift_left : t -> t -> t - val shift_right: t -> t -> t - - val c_lognot: t -> t - val c_logand: t -> t -> t - val c_logor : t -> t -> t - -end - -module type ArithIkind = -sig - type t - val neg: Cil.ikind -> t -> t - val add: Cil.ikind -> t -> t -> t - val sub: Cil.ikind -> t -> t -> t - val mul: Cil.ikind -> t -> t -> t - val div: Cil.ikind -> t -> t -> t - val rem: Cil.ikind -> t -> t -> t - - val lt: Cil.ikind -> t -> t -> t - val gt: Cil.ikind -> t -> t -> t - val le: Cil.ikind -> t -> t -> t - val ge: Cil.ikind -> t -> t -> t - val eq: Cil.ikind -> t -> t -> t - val ne: Cil.ikind -> t -> t -> t - - val lognot: Cil.ikind -> t -> t - val logand: Cil.ikind -> t -> t -> t - val logor : Cil.ikind -> t -> t -> t - val logxor: Cil.ikind -> t -> t -> t - - val shift_left : Cil.ikind -> t -> t -> t - val shift_right: Cil.ikind -> t -> t -> t - - val c_lognot: Cil.ikind -> t -> t - val c_logand: Cil.ikind -> t -> t -> t - val c_logor : Cil.ikind -> t -> t -> t - -end - -(* Shared functions between S and Z *) -module type B = -sig - include Lattice.S - type int_t - val bot_of: Cil.ikind -> t - val top_of: Cil.ikind -> t - val to_int: t -> int_t option - val equal_to: int_t -> t -> [`Eq | `Neq | `Top] - - val to_bool: t -> bool option - val to_excl_list: t -> (int_t list * (int64 * int64)) option - val of_excl_list: Cil.ikind -> int_t list -> t - val is_excl_list: t -> bool - - val to_incl_list: t -> int_t list option - - val maximal : t -> int_t option - val minimal : t -> int_t option - - val cast_to: ?suppress_ovwarn:bool -> ?torg:Cil.typ -> Cil.ikind -> t -> t -end - -(** Interface of IntDomain implementations that do not take ikinds for arithmetic operations yet. TODO: Should be ported to S in the future. *) -module type IkindUnawareS = -sig - include B - include Arith with type t := t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: int_t -> t - val of_bool: bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val arbitrary: unit -> t QCheck.arbitrary - val invariant: Cil.exp -> t -> Invariant.t -end - -(** Interface of IntDomain implementations taking an ikind for arithmetic operations *) -module type S = -sig - include B - include ArithIkind with type t:= t - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t - val neg : ?no_ov:bool -> Cil.ikind -> t -> t - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t - - val join: Cil.ikind -> t -> t -> t - val meet: Cil.ikind -> t -> t -> t - val narrow: Cil.ikind -> t -> t -> t - val widen: Cil.ikind -> t -> t -> t - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - val is_top_of: Cil.ikind -> t -> bool - val invariant_ikind : Cil.exp -> Cil.ikind -> t -> Invariant.t - - val refine_with_congruence: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_interval: Cil.ikind -> t -> (int_t * int_t) option -> t - val refine_with_excl_list: Cil.ikind -> t -> (int_t list * (int64 * int64)) option -> t - val refine_with_incl_list: Cil.ikind -> t -> int_t list option -> t - - val project: Cil.ikind -> int_precision -> t -> t - val arbitrary: Cil.ikind -> t QCheck.arbitrary -end - -module type SOverflow = -sig - - include S - - val add : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val sub : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val mul : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val div : ?no_ov:bool -> Cil.ikind -> t -> t -> t * overflow_info - - val neg : ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val cast_to : ?suppress_ovwarn:bool -> ?torg:Cil.typ -> ?no_ov:bool -> Cil.ikind -> t -> t * overflow_info - - val of_int : Cil.ikind -> int_t -> t * overflow_info - - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t * overflow_info - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t * overflow_info - - val shift_left : Cil.ikind -> t -> t -> t * overflow_info - - val shift_right : Cil.ikind -> t -> t -> t * overflow_info -end - -module type Y = -sig - (* include B *) - include B - include Arith with type t:= t - val of_int: Cil.ikind -> int_t -> t - val of_bool: Cil.ikind -> bool -> t - val of_interval: ?suppress_ovwarn:bool -> Cil.ikind -> int_t * int_t -> t - val of_congruence: Cil.ikind -> int_t * int_t -> t - - val starting : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val ending : ?suppress_ovwarn:bool -> Cil.ikind -> int_t -> t - val is_top_of: Cil.ikind -> t -> bool - - val project: int_precision -> t -> t - val invariant: Cil.exp -> t -> Invariant.t -end - -module type Z = Y with type int_t = Z.t - - -module IntDomLifter (I : S) = -struct - open Cil - type int_t = I.int_t - type t = { v : I.t; ikind : CilType.Ikind.t } [@@deriving eq, ord, hash] - - let ikind {ikind; _} = ikind - - (* Helper functions *) - let check_ikinds x y = if x.ikind <> y.ikind then raise (IncompatibleIKinds (GobPretty.sprintf "ikinds %a and %a are incompatible. Values: %a and %a" CilType.Ikind.pretty x.ikind CilType.Ikind.pretty y.ikind I.pretty x.v I.pretty y.v)) - let lift op x = {x with v = op x.ikind x.v } - (* For logical operations the result is of type int *) - let lift_logical op x = {v = op x.ikind x.v; ikind = Cil.IInt} - let lift2 op x y = check_ikinds x y; {x with v = op x.ikind x.v y.v } - let lift2_cmp op x y = check_ikinds x y; {v = op x.ikind x.v y.v; ikind = Cil.IInt} - - let bot_of ikind = { v = I.bot_of ikind; ikind} - let bot () = failwith "bot () is not implemented for IntDomLifter." - let is_bot x = I.is_bot x.v - let top_of ikind = { v = I.top_of ikind; ikind} - let top () = failwith "top () is not implemented for IntDomLifter." - let is_top x = I.is_top x.v - - (* Leq does not check for ikind, because it is used in invariant with arguments of different type. - TODO: check ikinds here and fix invariant to work with right ikinds *) - let leq x y = I.leq x.v y.v - let join = lift2 I.join - let meet = lift2 I.meet - let widen = lift2 I.widen - let narrow = lift2 I.narrow - - let show x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - "⊤" - else - I.show x.v (* TODO add ikind to output *) - let pretty () x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - Pretty.text "⊤" - else - I.pretty () x.v (* TODO add ikind to output *) - let pretty_diff () (x, y) = I.pretty_diff () (x.v, y.v) (* TODO check ikinds, add them to output *) - let printXml o x = - if not (GobConfig.get_bool "dbg.full-output") && I.is_top_of x.ikind x.v then - BatPrintf.fprintf o "\n\n⊤\n\n\n" - else - I.printXml o x.v (* TODO add ikind to output *) - (* This is for debugging *) - let name () = "IntDomLifter(" ^ (I.name ()) ^ ")" - let to_yojson x = I.to_yojson x.v - let invariant e x = - let e' = Cilfacade.mkCast ~e ~newt:(TInt (x.ikind, [])) in - I.invariant_ikind e' x.ikind x.v - let tag x = I.tag x.v - let arbitrary ik = failwith @@ "Arbitrary not implement for " ^ (name ()) ^ "." - let to_int x = I.to_int x.v - let of_int ikind x = { v = I.of_int ikind x; ikind} - let equal_to i x = I.equal_to i x.v - let to_bool x = I.to_bool x.v - let of_bool ikind b = { v = I.of_bool ikind b; ikind} - let to_excl_list x = I.to_excl_list x.v - let of_excl_list ikind is = {v = I.of_excl_list ikind is; ikind} - let is_excl_list x = I.is_excl_list x.v - let to_incl_list x = I.to_incl_list x.v - let of_interval ?(suppress_ovwarn=false) ikind (lb,ub) = {v = I.of_interval ~suppress_ovwarn ikind (lb,ub); ikind} - let of_congruence ikind (c,m) = {v = I.of_congruence ikind (c,m); ikind} - let starting ?(suppress_ovwarn=false) ikind i = {v = I.starting ~suppress_ovwarn ikind i; ikind} - let ending ?(suppress_ovwarn=false) ikind i = {v = I.ending ~suppress_ovwarn ikind i; ikind} - let maximal x = I.maximal x.v - let minimal x = I.minimal x.v - - let neg = lift I.neg - let add = lift2 I.add - let sub = lift2 I.sub - let mul = lift2 I.mul - let div = lift2 I.div - let rem = lift2 I.rem - let lt = lift2_cmp I.lt - let gt = lift2_cmp I.gt - let le = lift2_cmp I.le - let ge = lift2_cmp I.ge - let eq = lift2_cmp I.eq - let ne = lift2_cmp I.ne - let lognot = lift I.lognot - let logand = lift2 I.logand - let logor = lift2 I.logor - let logxor = lift2 I.logxor - let shift_left x y = {x with v = I.shift_left x.ikind x.v y.v } (* TODO check ikinds*) - let shift_right x y = {x with v = I.shift_right x.ikind x.v y.v } (* TODO check ikinds*) - let c_lognot = lift_logical I.c_lognot - let c_logand = lift2 I.c_logand - let c_logor = lift2 I.c_logor - - let cast_to ?(suppress_ovwarn=false) ?torg ikind x = {v = I.cast_to ~suppress_ovwarn ~torg:(TInt(x.ikind,[])) ikind x.v; ikind} - - let is_top_of ik x = ik = x.ikind && I.is_top_of ik x.v - - let relift x = { v = I.relift x.v; ikind = x.ikind } - - let project p v = { v = I.project v.ikind p v.v; ikind = v.ikind } -end - -module type Ikind = -sig - val ikind: unit -> Cil.ikind -end - -module PtrDiffIkind : Ikind = -struct - let ikind = Cilfacade.ptrdiff_ikind -end - -module IntDomWithDefaultIkind (I: Y) (Ik: Ikind) : Y with type t = I.t and type int_t = I.int_t = -struct - include I - let top () = I.top_of (Ik.ikind ()) - let bot () = I.bot_of (Ik.ikind ()) -end - -module Size = struct (* size in bits as int, range as int64 *) - open Cil - let sign x = if Z.compare x Z.zero < 0 then `Signed else `Unsigned - - let top_typ = TInt (ILongLong, []) - let min_for x = intKindForValue x (sign x = `Unsigned) - let bit = function (* bits needed for representation *) - | IBool -> 1 - | ik -> bytesSizeOfInt ik * 8 - let is_int64_big_int x = Z.fits_int64 x - let card ik = (* cardinality *) - let b = bit ik in - Z.shift_left Z.one b - let bits ik = (* highest bits for neg/pos values *) - let s = bit ik in - if isSigned ik then s-1, s-1 else 0, s - let bits_i64 ik = BatTuple.Tuple2.mapn Int64.of_int (bits ik) - let range ik = - let a,b = bits ik in - let x = if isSigned ik then Z.neg (Z.shift_left Z.one a) (* -2^a *) else Z.zero in - let y = Z.pred (Z.shift_left Z.one b) in (* 2^b - 1 *) - x,y - - let is_cast_injective ~from_type ~to_type = - let (from_min, from_max) = range (Cilfacade.get_ikind from_type) in - let (to_min, to_max) = range (Cilfacade.get_ikind to_type) in - if M.tracing then M.trace "int" "is_cast_injective %a (%a, %a) -> %a (%a, %a)" CilType.Typ.pretty from_type GobZ.pretty from_min GobZ.pretty from_max CilType.Typ.pretty to_type GobZ.pretty to_min GobZ.pretty to_max; - Z.compare to_min from_min <= 0 && Z.compare from_max to_max <= 0 - - let cast t x = (* TODO: overflow is implementation-dependent! *) - if t = IBool then - (* C11 6.3.1.2 Boolean type *) - if Z.equal x Z.zero then Z.zero else Z.one - else - let a,b = range t in - let c = card t in - let y = Z.erem x c in - let y = if Z.gt y b then Z.sub y c - else if Z.lt y a then Z.add y c - else y - in - if M.tracing then M.tracel "cast" "Cast %a to range [%a, %a] (%a) = %a (%s in int64)" GobZ.pretty x GobZ.pretty a GobZ.pretty b GobZ.pretty c GobZ.pretty y (if is_int64_big_int y then "fits" else "does not fit"); - y - - let min_range_sign_agnostic x = - let size ik = - let a,b = bits_i64 ik in - Int64.neg a,b - in - if sign x = `Signed then - size (min_for x) - else - let a, b = size (min_for x) in - if b <= 64L then - let upper_bound_less = Int64.sub b 1L in - let max_one_less = Z.(pred @@ shift_left Z.one (Int64.to_int upper_bound_less)) in - if x <= max_one_less then - a, upper_bound_less - else - a,b - else - a, b - - (* From the number of bits used to represent a positive value, determines the maximal representable value *) - let max_from_bit_range pos_bits = Z.(pred @@ shift_left Z.one (to_int (Z.of_int64 pos_bits))) - - (* From the number of bits used to represent a non-positive value, determines the minimal representable value *) - let min_from_bit_range neg_bits = Z.(if neg_bits = 0L then Z.zero else neg @@ shift_left Z.one (to_int (neg (Z.of_int64 neg_bits)))) - -end - - -module StdTop (B: sig type t val top_of: Cil.ikind -> t end) = struct - open B - (* these should be overwritten for better precision if possible: *) - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ik x = top_of ik - let ending ?(suppress_ovwarn=false) ik x = top_of ik - let maximal x = None - let minimal x = None -end - -module Std (B: sig - type t - val name: unit -> string - val top_of: Cil.ikind -> t - val bot_of: Cil.ikind -> t - val show: t -> string - val equal: t -> t -> bool - end) = struct - include Printable.StdLeaf - let name = B.name (* overwrite the one from Printable.Std *) - open B - let is_top x = failwith "is_top not implemented for IntDomain.Std" - let is_bot x = B.equal x (bot_of Cil.IInt) (* Here we assume that the representation of bottom is independent of the ikind - This may be true for intdomain implementations, but not e.g. for IntDomLifter. *) - let is_top_of ik x = B.equal x (top_of ik) - - (* all output is based on B.show *) - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - let pretty_diff () (x,y) = dprintf "%s: %a instead of %a" (name ()) pretty x pretty y - - include StdTop (B) -end - -(* Textbook interval arithmetic, without any overflow handling etc. *) -module IntervalArith (Ints_t : IntOps.IntOps) = struct - let min4 a b c d = Ints_t.min (Ints_t.min a b) (Ints_t.min c d) - let max4 a b c d = Ints_t.max (Ints_t.max a b) (Ints_t.max c d) - - let mul (x1, x2) (y1, y2) = - let x1y1 = (Ints_t.mul x1 y1) in - let x1y2 = (Ints_t.mul x1 y2) in - let x2y1 = (Ints_t.mul x2 y1) in - let x2y2 = (Ints_t.mul x2 y2) in - (min4 x1y1 x1y2 x2y1 x2y2, max4 x1y1 x1y2 x2y1 x2y2) - - let shift_left (x1,x2) (y1,y2) = - let y1p = Ints_t.shift_left Ints_t.one y1 in - let y2p = Ints_t.shift_left Ints_t.one y2 in - mul (x1, x2) (y1p, y2p) - - let div (x1, x2) (y1, y2) = - let x1y1n = (Ints_t.div x1 y1) in - let x1y2n = (Ints_t.div x1 y2) in - let x2y1n = (Ints_t.div x2 y1) in - let x2y2n = (Ints_t.div x2 y2) in - let x1y1p = (Ints_t.div x1 y1) in - let x1y2p = (Ints_t.div x1 y2) in - let x2y1p = (Ints_t.div x2 y1) in - let x2y2p = (Ints_t.div x2 y2) in - (min4 x1y1n x1y2n x2y1n x2y2n, max4 x1y1p x1y2p x2y1p x2y2p) - - let add (x1, x2) (y1, y2) = (Ints_t.add x1 y1, Ints_t.add x2 y2) - let sub (x1, x2) (y1, y2) = (Ints_t.sub x1 y2, Ints_t.sub x2 y1) - - let neg (x1, x2) = (Ints_t.neg x2, Ints_t.neg x1) - - let one = (Ints_t.one, Ints_t.one) - let zero = (Ints_t.zero, Ints_t.zero) - let top_bool = (Ints_t.zero, Ints_t.one) - - let to_int (x1, x2) = - if Ints_t.equal x1 x2 then Some x1 else None - - let upper_threshold u max_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - let max_ik' = Ints_t.to_bigint max_ik in - let t = List.find_opt (fun x -> Z.compare u x <= 0 && Z.compare x max_ik' <= 0) ts in - BatOption.map_default Ints_t.of_bigint max_ik t - let lower_threshold l min_ik = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - let min_ik' = Ints_t.to_bigint min_ik in - let t = List.find_opt (fun x -> Z.compare l x >= 0 && Z.compare x min_ik' >= 0) ts in - BatOption.map_default Ints_t.of_bigint min_ik t - let is_upper_threshold u = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.upper_thresholds () else ResettableLazy.force widening_thresholds in - let u = Ints_t.to_bigint u in - List.exists (Z.equal u) ts - let is_lower_threshold l = - let ts = if get_interval_threshold_widening_constants () = "comparisons" then WideningThresholds.lower_thresholds () else ResettableLazy.force widening_thresholds_desc in - let l = Ints_t.to_bigint l in - List.exists (Z.equal l) ts -end - -module IntInvariant = -struct - let of_int e ik x = - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.none - - let of_incl_list e ik ps = - match ps with - | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> - assert (List.mem Z.zero ps); - assert (List.mem Z.one ps); - Invariant.none - | [_] when get_bool "witness.invariant.exact" -> - Invariant.none - | _ :: _ :: _ - | [_] | [] -> - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ps - - let of_interval_opt e ik = function - | (Some x1, Some x2) when Z.equal x1 x2 -> - of_int e ik x1 - | x1_opt, x2_opt -> - let (min_ik, max_ik) = Size.range ik in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = - match x1_opt, inexact_type_bounds with - | Some x1, false when Z.equal min_ik x1 -> Invariant.none - | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) - | None, _ -> Invariant.none - in - let i2 = - match x2_opt, inexact_type_bounds with - | Some x2, false when Z.equal x2 max_ik -> Invariant.none - | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) - | None, _ -> Invariant.none - in - Invariant.(i1 && i2) - - let of_interval e ik (x1, x2) = - of_interval_opt e ik (Some x1, Some x2) - - let of_excl_list e ik ns = - List.fold_left (fun a x -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) (Invariant.top ()) ns -end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = struct @@ -1046,350 +412,3 @@ struct let project ik p t = t end - -module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct - include D - - let add ?no_ov ik x y = fst @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = fst @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = fst @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = fst @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = fst @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = fst @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = fst @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = fst @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = fst @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = fst @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = fst @@ D.shift_left ik x y - - let shift_right ik x y = fst @@ D.shift_right ik x y -end - -module IntIkind = struct let ikind () = Cil.IInt end -module Interval = IntervalFunctor (IntOps.BigIntOps) -module Interval32 = IntDomWithDefaultIkind (IntDomLifter (SOverflowUnlifter (IntervalFunctor (IntOps.Int64Ops)))) (IntIkind) - -module Integers (Ints_t : IntOps.IntOps): IkindUnawareS with type t = Ints_t.t and type int_t = Ints_t.t = (* no top/bot, order is <= *) -struct - include Printable.Std - let name () = "integers" - type t = Ints_t.t [@@deriving eq, ord, hash] - type int_t = Ints_t.t - let top () = raise Unknown - let bot () = raise Error - let top_of ik = top () - let bot_of ik = bot () - let show (x: Ints_t.t) = Ints_t.to_string x - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - (* is_top and is_bot are never called, but if they were, the Std impl would raise their exception, so we overwrite them: *) - let is_top _ = false - let is_bot _ = false - - let equal_to i x = if i > x then `Neq else `Top - let leq x y = x <= y - let join x y = if Ints_t.compare x y > 0 then x else y - let widen = join - let meet x y = if Ints_t.compare x y > 0 then y else x - let narrow = meet - - let of_bool x = if x then Ints_t.one else Ints_t.zero - let to_bool' x = x <> Ints_t.zero - let to_bool x = Some (to_bool' x) - let of_int x = x - let to_int x = Some x - - let neg = Ints_t.neg - let add = Ints_t.add (* TODO: signed overflow is undefined behavior! *) - let sub = Ints_t.sub - let mul = Ints_t.mul - let div = Ints_t.div - let rem = Ints_t.rem - let lt n1 n2 = of_bool (n1 < n2) - let gt n1 n2 = of_bool (n1 > n2) - let le n1 n2 = of_bool (n1 <= n2) - let ge n1 n2 = of_bool (n1 >= n2) - let eq n1 n2 = of_bool (n1 = n2) - let ne n1 n2 = of_bool (n1 <> n2) - let lognot = Ints_t.lognot - let logand = Ints_t.logand - let logor = Ints_t.logor - let logxor = Ints_t.logxor - let shift_left n1 n2 = Ints_t.shift_left n1 (Ints_t.to_int n2) - let shift_right n1 n2 = Ints_t.shift_right n1 (Ints_t.to_int n2) - let c_lognot n1 = of_bool (not (to_bool' n1)) - let c_logand n1 n2 = of_bool ((to_bool' n1) && (to_bool' n2)) - let c_logor n1 n2 = of_bool ((to_bool' n1) || (to_bool' n2)) - let cast_to ?(suppress_ovwarn=false) ?torg t x = failwith @@ "Cast_to not implemented for " ^ (name ()) ^ "." - let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 (* TODO: use ikind *) - let invariant _ _ = Invariant.none (* TODO *) -end - -module FlatPureIntegers: IkindUnawareS with type t = int64 and type int_t = int64 = (* Integers, but raises Unknown/Error on join/meet *) -struct - include Integers(IntOps.Int64Ops) - let top () = raise Unknown - let bot () = raise Error - let leq = equal - let pretty_diff () (x,y) = Pretty.dprintf "Integer %a instead of %a" pretty x pretty y - let join x y = if equal x y then x else top () - let meet x y = if equal x y then x else bot () -end - -module Flat (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) -struct - type int_t = Base.int_t - include Lattice.FlatConf (struct - include Printable.DefaultConf - let top_name = "Unknown int" - let bot_name = "Error int" - end) (Base) - - let top_of ik = top () - let bot_of ik = bot () - - - let name () = "flat integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let to_excl_list x = None - let of_excl_list ik x = top_of ik - let is_excl_list x = false - let to_incl_list x = None - let of_interval ?(suppress_ovwarn=false) ik x = top_of ik - let of_congruence ik x = top_of ik - let starting ?(suppress_ovwarn=false) ikind x = top_of ikind - let ending ?(suppress_ovwarn=false) ikind x = top_of ikind - let maximal x = None - let minimal x = None - - let lift1 f x = match x with - | `Lifted x -> - (try `Lifted (f x) with Unknown -> `Top | Error -> `Bot) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> - (try `Lifted (f x y) with Unknown -> `Top | Error -> `Bot) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Lift (Base: IkindUnawareS): IkindUnawareS with type t = [ `Bot | `Lifted of Base.t | `Top ] and type int_t = Base.int_t = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) -struct - include Lattice.LiftPO (struct - include Printable.DefaultConf - let top_name = "MaxInt" - let bot_name = "MinInt" - end) (Base) - type int_t = Base.int_t - let top_of ik = top () - let bot_of ik = bot () - include StdTop (struct type nonrec t = t let top_of = top_of end) - - let name () = "lifted integers" - let cast_to ?(suppress_ovwarn=false) ?torg t = function - | `Lifted x -> `Lifted (Base.cast_to t x) - | x -> x - - let equal_to i = function - | `Bot -> failwith "unsupported: equal_to with bottom" - | `Top -> `Top - | `Lifted x -> Base.equal_to i x - - let of_int x = `Lifted (Base.of_int x) - let to_int x = match x with - | `Lifted x -> Base.to_int x - | _ -> None - - let of_bool x = `Lifted (Base.of_bool x) - let to_bool x = match x with - | `Lifted x -> Base.to_bool x - | _ -> None - - let lift1 f x = match x with - | `Lifted x -> `Lifted (f x) - | x -> x - let lift2 f x y = match x,y with - | `Lifted x, `Lifted y -> `Lifted (f x y) - | `Bot, `Bot -> `Bot - | _ -> `Top - - let neg = lift1 Base.neg - let add = lift2 Base.add - let sub = lift2 Base.sub - let mul = lift2 Base.mul - let div = lift2 Base.div - let rem = lift2 Base.rem - let lt = lift2 Base.lt - let gt = lift2 Base.gt - let le = lift2 Base.le - let ge = lift2 Base.ge - let eq = lift2 Base.eq - let ne = lift2 Base.ne - let lognot = lift1 Base.lognot - let logand = lift2 Base.logand - let logor = lift2 Base.logor - let logxor = lift2 Base.logxor - let shift_left = lift2 Base.shift_left - let shift_right = lift2 Base.shift_right - let c_lognot = lift1 Base.c_lognot - let c_logand = lift2 Base.c_logand - let c_logor = lift2 Base.c_logor - - let invariant e = function - | `Lifted x -> Base.invariant e x - | `Top | `Bot -> Invariant.none -end - -module Flattened = Flat (Integers (IntOps.Int64Ops)) -module Lifted = Lift (Integers (IntOps.Int64Ops)) - -module Reverse (Base: IkindUnawareS) = -struct - include Base - include (Lattice.Reverse (Base) : Lattice.S with type t := Base.t) -end - -module BISet = struct - include SetDomain.Make (IntOps.BigIntOps) - let is_singleton s = cardinal s = 1 -end - -(* The module [Exclusion] constains common functionality about handling of exclusion sets between [DefExc] and [Enums] *) -module Exclusion = -struct - module R = Interval32 - (* We use these types for the functions in this module to make the intended meaning more explicit *) - type t = Exc of BISet.t * Interval32.t - type inc = Inc of BISet.t [@@unboxed] - let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) - let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) - let cardinality_of_range r = Z.succ (Z.add (Z.neg (min_of_range r)) (max_of_range r)) - - let cardinality_BISet s = - Z.of_int (BISet.cardinal s) - - let leq_excl_incl (Exc (xs, r)) (Inc ys) = - (* For a <= b to hold, the cardinalities must fit, i.e. |a| <= |b|, which implies |min_r, max_r| - |xs| <= |ys|. We check this first. *) - let lower_bound_cardinality_a = Z.sub (cardinality_of_range r) (cardinality_BISet xs) in - let card_b = cardinality_BISet ys in - if Z.compare lower_bound_cardinality_a card_b > 0 then - false - else (* The cardinality did fit, so we check for all elements that are represented by range r, whether they are in (xs union ys) *) - let min_a = min_of_range r in - let max_a = max_of_range r in - GobZ.for_all_range (fun el -> BISet.mem el xs || BISet.mem el ys) (min_a, max_a) - - let leq (Exc (xs, r)) (Exc (ys, s)) = - let min_a, max_a = min_of_range r, max_of_range r in - let excluded_check = BISet.for_all (fun y -> BISet.mem y xs || Z.compare y min_a < 0 || Z.compare y max_a > 0) ys in (* if true, then the values ys, that are not in b, also do not occur in a *) - if not excluded_check - then false - else begin (* Check whether all elements that are in the range r, but not in s, are in xs, i.e. excluded. *) - if R.leq r s then true - else begin if Z.compare (cardinality_BISet xs) (Z.sub (cardinality_of_range r) (cardinality_of_range s)) >= 0 (* Check whether the number of excluded elements in a is as least as big as |min_r, max_r| - |min_s, max_s| *) - then - let min_b, max_b = min_of_range s, max_of_range s in - let leq1 = (* check whether the elements in [r_l; s_l-1] are all in xs, i.e. excluded *) - if Z.compare min_a min_b < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (min_a, Z.pred min_b) - else - true - in - let leq2 () = (* check whether the elements in [s_u+1; r_u] are all in xs, i.e. excluded *) - if Z.compare max_b max_a < 0 then - GobZ.for_all_range (fun x -> BISet.mem x xs) (Z.succ max_b, max_a) - else - true - in - leq1 && (leq2 ()) - else - false - end - end -end - -module SOverflowLifter (D : S) : SOverflow with type int_t = D.int_t and type t = D.t = struct - - include D - - let lift v = (v, {overflow=false; underflow=false}) - - let add ?no_ov ik x y = lift @@ D.add ?no_ov ik x y - - let sub ?no_ov ik x y = lift @@ D.sub ?no_ov ik x y - - let mul ?no_ov ik x y = lift @@ D.mul ?no_ov ik x y - - let div ?no_ov ik x y = lift @@ D.div ?no_ov ik x y - - let neg ?no_ov ik x = lift @@ D.neg ?no_ov ik x - - let cast_to ?suppress_ovwarn ?torg ?no_ov ik x = lift @@ D.cast_to ?suppress_ovwarn ?torg ?no_ov ik x - - let of_int ik x = lift @@ D.of_int ik x - - let of_interval ?suppress_ovwarn ik x = lift @@ D.of_interval ?suppress_ovwarn ik x - - let starting ?suppress_ovwarn ik x = lift @@ D.starting ?suppress_ovwarn ik x - - let ending ?suppress_ovwarn ik x = lift @@ D.ending ?suppress_ovwarn ik x - - let shift_left ik x y = lift @@ D.shift_left ik x y - - let shift_right ik x y = lift @@ D.shift_right ik x y - -end From 127603f4cf2c71bbc833df3932ee69d24b6bb914 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:11:08 +0300 Subject: [PATCH 116/157] Remove IntervalFunctor from IntDomain0 --- src/cdomain/value/cdomains/intDomain0.ml | 412 ----------------------- 1 file changed, 412 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain0.ml b/src/cdomain/value/cdomains/intDomain0.ml index 67d7da2125..377ef1576d 100644 --- a/src/cdomain/value/cdomains/intDomain0.ml +++ b/src/cdomain/value/cdomains/intDomain0.ml @@ -635,418 +635,6 @@ struct ) (Invariant.top ()) ns end -module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = -struct - let name () = "intervals" - type int_t = Ints_t.t - type t = (Ints_t.t * Ints_t.t) option [@@deriving eq, ord, hash] - module IArith = IntervalArith (Ints_t) - - let range ik = BatTuple.Tuple2.mapn Ints_t.of_bigint (Size.range ik) - - let top () = failwith @@ "top () not implemented for " ^ (name ()) - let top_of ik = Some (range ik) - let bot () = None - let bot_of ik = bot () (* TODO: improve *) - - let show = function None -> "bottom" | Some (x,y) -> "["^Ints_t.to_string x^","^Ints_t.to_string y^"]" - - include Std (struct type nonrec t = t let name = name let top_of = top_of let bot_of = bot_of let show = show let equal = equal end) - - let equal_to i = function - | None -> failwith "unsupported: equal_to with bottom" - | Some (a, b) -> - if a = b && b = i then `Eq else if Ints_t.compare a i <= 0 && Ints_t.compare i b <=0 then `Top else `Neq - - let norm ?(suppress_ovwarn=false) ?(cast=false) ik : (t -> t * overflow_info) = function None -> (None, {underflow=false; overflow=false}) | Some (x,y) -> - if Ints_t.compare x y > 0 then - (None,{underflow=false; overflow=false}) - else ( - let (min_ik, max_ik) = range ik in - let underflow = Ints_t.compare min_ik x > 0 in - let overflow = Ints_t.compare max_ik y < 0 in - let ov_info = { underflow = underflow && not suppress_ovwarn; overflow = overflow && not suppress_ovwarn } in - let v = - if underflow || overflow then - if should_wrap ik then (* could add [|| cast], but that's GCC implementation-defined behavior: https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html#Integers-implementation *) - (* We can only soundly wrap if at most one overflow occurred, otherwise the minimal and maximal values of the interval *) - (* on Z will not safely contain the minimal and maximal elements after the cast *) - let diff = Ints_t.abs (Ints_t.sub max_ik min_ik) in - let resdiff = Ints_t.abs (Ints_t.sub y x) in - if Ints_t.compare resdiff diff > 0 then - top_of ik - else - let l = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint x) in - let u = Ints_t.of_bigint @@ Size.cast ik (Ints_t.to_bigint y) in - if Ints_t.compare l u <= 0 then - Some (l, u) - else - (* Interval that wraps around (begins to the right of its end). We can not represent such intervals *) - top_of ik - else if not cast && should_ignore_overflow ik then - let tl, tu = BatOption.get @@ top_of ik in - Some (Ints_t.max tl x, Ints_t.min tu y) - else - top_of ik - else - Some (x,y) - in - (v, ov_info) - ) - - let leq (x:t) (y:t) = - match x, y with - | None, _ -> true - | Some _, None -> false - | Some (x1,x2), Some (y1,y2) -> Ints_t.compare x1 y1 >= 0 && Ints_t.compare x2 y2 <= 0 - - let join ik (x:t) y = - match x, y with - | None, z | z, None -> z - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.min x1 y1, Ints_t.max x2 y2) |> fst - - let meet ik (x:t) y = - match x, y with - | None, z | z, None -> None - | Some (x1,x2), Some (y1,y2) -> norm ik @@ Some (Ints_t.max x1 y1, Ints_t.min x2 y2) |> fst - - (* TODO: change to_int signature so it returns a big_int *) - let to_int x = Option.bind x (IArith.to_int) - let of_interval ?(suppress_ovwarn=false) ik (x,y) = norm ~suppress_ovwarn ik @@ Some (x,y) - let of_int ik (x: int_t) = of_interval ik (x,x) - let zero = Some IArith.zero - let one = Some IArith.one - let top_bool = Some IArith.top_bool - - let of_bool _ik = function true -> one | false -> zero - let to_bool (a: t) = match a with - | None -> None - | Some (l, u) when Ints_t.compare l Ints_t.zero = 0 && Ints_t.compare u Ints_t.zero = 0 -> Some false - | x -> if leq zero x then None else Some true - - let starting ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (n, snd (range ik)) - - let ending ?(suppress_ovwarn=false) ik n = - norm ~suppress_ovwarn ik @@ Some (fst (range ik), n) - - (* TODO: change signature of maximal, minimal to return big_int*) - let maximal = function None -> None | Some (x,y) -> Some y - let minimal = function None -> None | Some (x,y) -> Some x - - let cast_to ?(suppress_ovwarn=false) ?torg ?no_ov t = norm ~cast:true t (* norm does all overflow handling *) - - let widen ik x y = - match x, y with - | None, z | z, None -> z - | Some (l0,u0), Some (l1,u1) -> - let (min_ik, max_ik) = range ik in - let threshold = get_interval_threshold_widening () in - let l2 = - if Ints_t.compare l0 l1 = 0 then l0 - else if threshold then IArith.lower_threshold l1 min_ik - else min_ik - in - let u2 = - if Ints_t.compare u0 u1 = 0 then u0 - else if threshold then IArith.upper_threshold u1 max_ik - else max_ik - in - norm ik @@ Some (l2,u2) |> fst - let widen ik x y = - let r = widen ik x y in - if M.tracing && not (equal x y) then M.tracel "int" "interval widen %a %a -> %a" pretty x pretty y pretty r; - assert (leq x y); (* TODO: remove for performance reasons? *) - r - - let narrow ik x y = - match x, y with - | _,None | None, _ -> None - | Some (x1,x2), Some (y1,y2) -> - let threshold = get_interval_threshold_widening () in - let (min_ik, max_ik) = range ik in - let lr = if Ints_t.compare min_ik x1 = 0 || threshold && Ints_t.compare y1 x1 > 0 && IArith.is_lower_threshold x1 then y1 else x1 in - let ur = if Ints_t.compare max_ik x2 = 0 || threshold && Ints_t.compare y2 x2 < 0 && IArith.is_upper_threshold x2 then y2 else x2 in - norm ik @@ Some (lr,ur) |> fst - - - let narrow ik x y = - if get_interval_narrow_by_meet () then - meet ik x y - else - narrow ik x y - - let log f ~annihilator ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_bool i1, to_bool i2 with - | Some x, _ when x = annihilator -> of_bool ik annihilator - | _, Some y when y = annihilator -> of_bool ik annihilator - | Some x, Some y -> of_bool ik (f x y) - | _ -> top_of ik - - let c_logor = log (||) ~annihilator:true - let c_logand = log (&&) ~annihilator:false - - let log1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_bool i1 with - | Some x -> of_bool ik (f ik x) - | _ -> top_of ik - - let c_lognot = log1 (fun _ik -> not) - - let bit f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) |> fst with Division_by_zero -> top_of ik) - | _ -> top_of ik - - let bitcomp f ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (f ik x y) with Division_by_zero | Invalid_argument _ -> (top_of ik,{underflow=false; overflow=false})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let logxor = bit (fun _ik -> Ints_t.logxor) - - let logand ik i1 i2 = - match is_bot i1, is_bot i2 with - | true, true -> bot_of ik - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show i1) (show i2))) - | _ -> - match to_int i1, to_int i2 with - | Some x, Some y -> (try of_int ik (Ints_t.logand x y) |> fst with Division_by_zero -> top_of ik) - | _, Some y when Ints_t.equal y Ints_t.zero -> of_int ik Ints_t.zero |> fst - | _, Some y when Ints_t.equal y Ints_t.one -> of_interval ik (Ints_t.zero, Ints_t.one) |> fst - | _ -> top_of ik - - let logor = bit (fun _ik -> Ints_t.logor) - - let bit1 f ik i1 = - if is_bot i1 then - bot_of ik - else - match to_int i1 with - | Some x -> of_int ik (f ik x) |> fst - | _ -> top_of ik - - let lognot = bit1 (fun _ik -> Ints_t.lognot) - let shift_right = bitcomp (fun _ik x y -> Ints_t.shift_right x (Ints_t.to_int y)) - - let neg ?no_ov ik = function None -> (None,{underflow=false; overflow=false}) | Some x -> norm ik @@ Some (IArith.neg x) - - let binary_op_with_norm ?no_ov op ik x y = match x, y with - | None, None -> (None, {overflow=false; underflow= false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some x, Some y -> norm ik @@ Some (op x y) - - let add ?no_ov = binary_op_with_norm IArith.add - let mul ?no_ov = binary_op_with_norm IArith.mul - let sub ?no_ov = binary_op_with_norm IArith.sub - - let shift_left ik a b = - match is_bot a, is_bot b with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show a) (show b))) - | _ -> - match a, minimal b, maximal b with - | Some a, Some bl, Some bu when (Ints_t.compare bl Ints_t.zero >= 0) -> - (try - let r = IArith.shift_left a (Ints_t.to_int bl, Ints_t.to_int bu) in - norm ik @@ Some r - with Z.Overflow -> (top_of ik,{underflow=false; overflow=true})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - - let rem ik x y = match x, y with - | None, None -> None - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (xl, xu), Some (yl, yu) -> - if is_top_of ik x && is_top_of ik y then - (* This is needed to preserve soundness also on things bigger than int32 e.g. *) - (* x: 3803957176L -> T in Interval32 *) - (* y: 4209861404L -> T in Interval32 *) - (* x % y: 3803957176L -> T in Interval32 *) - (* T in Interval32 is [-2147483648,2147483647] *) - (* the code below computes [-2147483647,2147483647] for this though which is unsound *) - top_of ik - else - (* If we have definite values, Ints_t.rem will give a definite result. - * Otherwise we meet with a [range] the result can be in. - * This range is [0, min xu b] if x is positive, and [max xl -b, min xu b] if x can be negative. - * The precise bound b is one smaller than the maximum bound. Negative y give the same result as positive. *) - let pos x = if Ints_t.compare x Ints_t.zero < 0 then Ints_t.neg x else x in - let b = Ints_t.sub (Ints_t.max (pos yl) (pos yu)) Ints_t.one in - let range = if Ints_t.compare xl Ints_t.zero>= 0 then Some (Ints_t.zero, Ints_t.min xu b) else Some (Ints_t.max xl (Ints_t.neg b), Ints_t.min (Ints_t.max (pos xl) (pos xu)) b) in - meet ik (bit (fun _ik -> Ints_t.rem) ik x y) range - - let rec div ?no_ov ik x y = - match x, y with - | None, None -> (bot (),{underflow=false; overflow=false}) - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | (Some (x1,x2) as x), (Some (y1,y2) as y) -> - begin - let is_zero v = Ints_t.compare v Ints_t.zero = 0 in - match y1, y2 with - | l, u when is_zero l && is_zero u -> (top_of ik,{underflow=false; overflow=false}) (* TODO warn about undefined behavior *) - | l, _ when is_zero l -> div ik (Some (x1,x2)) (Some (Ints_t.one,y2)) - | _, u when is_zero u -> div ik (Some (x1,x2)) (Some (y1, Ints_t.(neg one))) - | _ when leq (of_int ik (Ints_t.zero) |> fst) (Some (y1,y2)) -> (top_of ik,{underflow=false; overflow=false}) - | _ -> binary_op_with_norm IArith.div ik x y - end - - let ne ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik true - else if Ints_t.compare x2 y1 <= 0 && Ints_t.compare y2 x1 <= 0 then - of_bool ik false - else top_bool - - let eq ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 && Ints_t.compare x2 y1 <= 0 then - of_bool ik true - else if Ints_t.compare y2 x1 < 0 || Ints_t.compare x2 y1 < 0 then - of_bool ik false - else top_bool - - let ge ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 <= 0 then of_bool ik true - else if Ints_t.compare x2 y1 < 0 then of_bool ik false - else top_bool - - let le ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 <= 0 then of_bool ik true - else if Ints_t.compare y2 x1 < 0 then of_bool ik false - else top_bool - - let gt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare y2 x1 < 0 then of_bool ik true - else if Ints_t.compare x2 y1 <= 0 then of_bool ik false - else top_bool - - let lt ik x y = - match x, y with - | None, None -> bot_of ik - | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) - | Some (x1,x2), Some (y1,y2) -> - if Ints_t.compare x2 y1 < 0 then of_bool ik true - else if Ints_t.compare y2 x1 <= 0 then of_bool ik false - else top_bool - - let invariant_ikind e ik = function - | Some (x1, x2) -> - let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in - IntInvariant.of_interval e ik (x1', x2') - | None -> Invariant.none - - let arbitrary ik = - let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) - (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in - let pair_arb = QCheck.pair int_arb int_arb in - let shrink = function - | Some (l, u) -> (return None) <+> (GobQCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) - | None -> empty - in - QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) (fun x -> of_interval ik x |> fst ) pair_arb) - - let modulo n k = - let result = Ints_t.rem n k in - if Ints_t.compare result Ints_t.zero >= 0 then result - else Ints_t.add result k - - let refine_with_congruence ik (intv : t) (cong : (int_t * int_t ) option) : t = - match intv, cong with - | Some (x, y), Some (c, m) -> - if Ints_t.equal m Ints_t.zero && (Ints_t.compare c x < 0 || Ints_t.compare c y > 0) then None - else if Ints_t.equal m Ints_t.zero then - Some (c, c) - else - let (min_ik, max_ik) = range ik in - let rcx = - if Ints_t.equal x min_ik then x else - Ints_t.add x (modulo (Ints_t.sub c x) (Ints_t.abs m)) in - let lcy = - if Ints_t.equal y max_ik then y else - Ints_t.sub y (modulo (Ints_t.sub y c) (Ints_t.abs m)) in - if Ints_t.compare rcx lcy > 0 then None - else if Ints_t.equal rcx lcy then norm ik @@ Some (rcx, rcx) |> fst - else norm ik @@ Some (rcx, lcy) |> fst - | _ -> None - - let refine_with_congruence ik x y = - let refn = refine_with_congruence ik x y in - if M.tracing then M.trace "refine" "int_refine_with_congruence %a %a -> %a" pretty x pretty y pretty refn; - refn - - let refine_with_interval ik a b = meet ik a b - - let refine_with_excl_list ik (intv : t) (excl : (int_t list * (int64 * int64)) option) : t = - match intv, excl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls, (rl, rh)) -> - let rec shrink op b = - let new_b = (op b (Ints_t.of_int(Bool.to_int(BatList.mem_cmp Ints_t.compare b ls)))) in - if not (Ints_t.equal b new_b) then shrink op new_b else new_b - in - let (min_ik, max_ik) = range ik in - let l' = if Ints_t.equal l min_ik then l else shrink Ints_t.add l in - let u' = if Ints_t.equal u max_ik then u else shrink Ints_t.sub u in - let intv' = norm ik @@ Some (l', u') |> fst in - let range = norm ~suppress_ovwarn:true ik (Some (Ints_t.of_bigint (Size.min_from_bit_range rl), Ints_t.of_bigint (Size.max_from_bit_range rh))) |> fst in - meet ik intv' range - - let refine_with_incl_list ik (intv: t) (incl : (int_t list) option) : t = - match intv, incl with - | None, _ | _, None -> intv - | Some(l, u), Some(ls) -> - let rec min m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> min (Some x) xs | Some m -> if Ints_t.compare m x < 0 then min (Some m) xs else min (Some x) xs in - let rec max m1 ms = match ms with | [] -> m1 | x::xs -> match m1 with - | None -> max (Some x) xs | Some m -> if Ints_t.compare m x > 0 then max (Some m) xs else max (Some x) xs in - match min None ls, max None ls with - | Some m1, Some m2 -> refine_with_interval ik (Some(l, u)) (Some (m1, m2)) - | _, _-> intv - - let project ik p t = t -end - module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t = struct include D From db37e858017d939c952836e7c0b7f5d3295efe8d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 25 Oct 2024 17:25:13 +0300 Subject: [PATCH 117/157] Add IntDomain exclusions to goblint-lib-modules.py --- scripts/goblint-lib-modules.py | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/scripts/goblint-lib-modules.py b/scripts/goblint-lib-modules.py index ba25a1403c..eee7b218c5 100755 --- a/scripts/goblint-lib-modules.py +++ b/scripts/goblint-lib-modules.py @@ -48,6 +48,12 @@ "MessageCategory", # included in Messages "PreValueDomain", # included in ValueDomain + "IntervalDomain", # included in IntDomain + "IntervalSetDomain", # included in IntDomain + "DefExcDomain", # included in IntDomain + "EnumsDomain", # included in IntDomain + "CongruenceDomain", # included in IntDomain + "IntDomTuple", # included in IntDomain "ConfigVersion", "ConfigProfile", From f7184c06244e8919638a3870a7922fd37a1e817b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 4 Nov 2024 11:08:17 +0200 Subject: [PATCH 118/157] Print innermost backtrace mark for uncaught exception even with backtrace printing off --- src/util/backtrace/goblint_backtrace.ml | 9 ++++++++- src/util/backtrace/goblint_backtrace.mli | 5 +++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/util/backtrace/goblint_backtrace.ml b/src/util/backtrace/goblint_backtrace.ml index 513753bddb..21d150a470 100644 --- a/src/util/backtrace/goblint_backtrace.ml +++ b/src/util/backtrace/goblint_backtrace.ml @@ -76,12 +76,19 @@ let print_marktrace oc e = Printf.fprintf oc "Marked with %s\n" (mark_to_string m) ) ms +let print_innermost_mark oc e = + match find_marks e with + | m :: _ -> Printf.fprintf oc "Marked with %s\n" (mark_to_string m) + | [] -> () + let () = Printexc.set_uncaught_exception_handler (fun e bt -> (* Copied & modified from Printexc.default_uncaught_exception_handler. *) Printf.eprintf "Fatal error: exception %s\n" (Printexc.to_string e); (* nosemgrep: print-not-logging *) if Printexc.backtrace_status () then - print_marktrace stderr e; + print_marktrace stderr e + else + print_innermost_mark stderr e; Printexc.print_raw_backtrace stderr bt; flush stderr ) diff --git a/src/util/backtrace/goblint_backtrace.mli b/src/util/backtrace/goblint_backtrace.mli index e53bfd826a..ee7052122e 100644 --- a/src/util/backtrace/goblint_backtrace.mli +++ b/src/util/backtrace/goblint_backtrace.mli @@ -32,5 +32,10 @@ val print_marktrace: out_channel -> exn -> unit Used by default for uncaught exceptions. *) +val print_innermost_mark: out_channel -> exn -> unit +(** Print innermost mark of an exception. + + Used by default for uncaught exceptions. *) + val find_marks: exn -> mark list (** Find all marks of an exception. *) From f2f0c12d0a3ba6946430c467f812b72acc8ad4e0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 14 Nov 2024 10:48:10 +0200 Subject: [PATCH 119/157] Error on must-relocking of non-recursive mutex mayLocks analysis can warn on it, but mutex analysis can be definite about it. --- src/analyses/mutexAnalysis.ml | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 9b6aa4f4ca..a608b3b6e3 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -121,14 +121,17 @@ struct let add ctx ((addr, rw): AddrRW.t): D.t = match addr with - | Addr mv -> + | Addr ((v, o) as mv) -> let (s, m) = ctx.local in let s' = MustLocksetRW.add_mval_rw (mv, rw) s in let m' = - if MutexTypeAnalysis.must_be_recursive ctx mv then - MustMultiplicity.increment mv m - else + match ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) with + | `Lifted Recursive -> MustMultiplicity.increment mv m + | `Lifted NonRec -> + if MustLocksetRW.mem_mval mv s then + M.error ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a non-recursive mutex that is already held"; m + | `Bot | `Top -> m in (s', m') | NullPtr -> From ced56ca4882ae5c461d1a7aefd435e814283c02a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 10:06:41 +0200 Subject: [PATCH 120/157] Document YamlEntryGlobal and InvariantGlobalNodes queries --- src/domains/queries.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 5436e5f7e0..e3a0a3e776 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -131,9 +131,9 @@ type _ t = | TmpSpecial: Mval.Exp.t -> ML.t t | MaySignedOverflow: exp -> MayBool.t t | GasExhausted: MustBool.t t - | YamlEntryGlobal: Obj.t * YamlWitnessType.Task.t -> YS.t t + | YamlEntryGlobal: Obj.t * YamlWitnessType.Task.t -> YS.t t (** YAML witness entries for a global unknown ([Obj.t] represents [Spec.V.t]) and YAML witness task. *) | GhostVarAvailable: WitnessGhostVar.t -> MayBool.t t - | InvariantGlobalNodes: NS.t t (* TODO: V.t argument? *) + | InvariantGlobalNodes: NS.t t (** Nodes where YAML witness flow-insensitive invariants should be emitted as location invariants (if [witness.invariant.flow_insensitive-as] is configured to do so). *) (* [Spec.V.t] argument (as [Obj.t]) could be added, if this should be different for different flow-insensitive invariants. *) type 'a result = 'a From 969b87a02e7e956beb8911dc753c42918510a48d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 10:10:38 +0200 Subject: [PATCH 121/157] Replace privatization invariant_global mutex_inits TODO with comment --- src/analyses/apron/relationPriv.apron.ml | 2 +- src/analyses/basePriv.ml | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 9b25abb371..abaaa0d9b8 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -722,7 +722,7 @@ struct let one_var = GobConfig.get_bool "ana.relation.invariant.one-var" in let exact = GobConfig.get_bool "witness.invariant.exact" in - let rel = keep_only_protected_globals ask m' (get_m_with_mutex_inits ask getg m') in (* TODO: disjunct with mutex_inits instead of join? *) + let rel = keep_only_protected_globals ask m' (get_m_with_mutex_inits ask getg m') in (* Could be more precise if mutex_inits invariant is added by disjunction instead of joining abstract values. *) let inv = RD.invariant rel |> List.enum diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 347a365778..7a67d0e0fc 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -250,7 +250,7 @@ struct let invariant_global ask getg = function | `Right g' -> (* global *) - ValueDomain.invariant_global (read_unprotected_global getg) g' (* TODO: disjunct with mutex_inits instead of join? *) + ValueDomain.invariant_global (read_unprotected_global getg) g' (* Could be more precise if mutex_inits invariant is added by disjunction instead of joining abstract values. *) | _ -> (* mutex *) Invariant.none @@ -343,7 +343,7 @@ struct | `Left m' -> (* mutex *) let atomic = LockDomain.MustLock.equal m' (LockDomain.MustLock.of_var LibraryFunctions.verifier_atomic_var) in if atomic || ask.f (GhostVarAvailable (Locked m')) then ( - let cpa = get_m_with_mutex_inits ask getg m' in (* TODO: disjunct with mutex_inits instead of join? *) + let cpa = get_m_with_mutex_inits ask getg m' in (* Could be more precise if mutex_inits invariant is added by disjunction instead of joining abstract values. *) let inv = CPA.fold (fun v _ acc -> if ask.f (MustBeProtectedBy {mutex = m'; global = v; write = true; protection = Strong}) then let inv = ValueDomain.invariant_global (fun g -> CPA.find g cpa) v in @@ -704,7 +704,7 @@ struct let invariant_global ask getg = function | `Middle g -> (* global *) - ValueDomain.invariant_global (read_unprotected_global getg) g (* TODO: disjunct with mutex_inits instead of join? *) + ValueDomain.invariant_global (read_unprotected_global getg) g (* Could be more precise if mutex_inits invariant is added by disjunction instead of joining abstract values. *) | `Left _ | `Right _ -> (* mutex or thread *) Invariant.none From 4940658a23799a16f78731570ca9921ff8f2b0f2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 10:15:27 +0200 Subject: [PATCH 122/157] Apply suggestions from code review Co-authored-by: Julian Erhard --- src/analyses/mutexGhosts.ml | 1 - src/witness/witnessGhostVar.ml | 4 ++-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 09afc41baa..87e7281028 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -10,7 +10,6 @@ struct include UnitAnalysis.Spec let name () = "mutexGhosts" - (* module ThreadCreate = Printable.UnitConf (struct let name = "threadcreate" end) *) module V = struct include Printable.Either3 (Node) (LockDomain.MustLock) (BoolDomain.Bool) diff --git a/src/witness/witnessGhostVar.ml b/src/witness/witnessGhostVar.ml index 82813b4a65..0d71909ba0 100644 --- a/src/witness/witnessGhostVar.ml +++ b/src/witness/witnessGhostVar.ml @@ -35,9 +35,9 @@ include Printable.SimpleShow (struct let describe_varinfo _ _ = "" let typ = function - | Locked _ -> GoblintCil.intType + | Locked _ | Multithreaded -> GoblintCil.intType let initial = function - | Locked _ -> GoblintCil.zero + | Locked _ | Multithreaded -> GoblintCil.zero From 09045bc232f7cf0e36389534eb3fc5e56e1d81d7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 10:32:17 +0200 Subject: [PATCH 123/157] Add nontrivial condition for querying YamlEntryGlobal at all --- src/witness/yamlWitness.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index f8890d8eaa..ec83fa04fb 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -397,7 +397,7 @@ struct (* Generate flow-insensitive entries (ghost variables and ghost updates) *) let entries = - if true then ( + if (entry_type_enabled YamlWitnessType.GhostVariable.entry_type && entry_type_enabled YamlWitnessType.GhostUpdate.entry_type) || entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type then ( GHT.fold (fun g v acc -> match g with | `Left g -> (* Spec global *) From 3a07c1615d9a4888a0e972fc6da69719d91e9fb6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 10:47:07 +0200 Subject: [PATCH 124/157] Remove old unnecessary branching from ghost_update YAML witness entries --- src/witness/yamlWitnessType.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 7834951892..fa2d55d2c2 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -464,7 +464,6 @@ struct variable: string; expression: string; location: Location.t; - (* TODO: branching? *) } [@@deriving eq, ord, hash] From 9a3a338287664b9697bf2eaa0eca378bd5be247b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 10:53:46 +0200 Subject: [PATCH 125/157] Implement YamlWitnessType.Entry pretty-printing --- src/witness/yamlWitnessType.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index fa2d55d2c2..6ec133c7d6 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -693,12 +693,6 @@ struct let name () = "YAML entry" - let show _ = "TODO" - include Printable.SimpleShow (struct - type nonrec t = t - let show = show - end) - let to_yaml {entry_type; metadata} = `O ([ ("entry_type", `String (EntryType.entry_type entry_type)); @@ -710,4 +704,10 @@ struct let+ metadata = y |> find "metadata" >>= Metadata.of_yaml and+ entry_type = y |> EntryType.of_yaml in {entry_type; metadata} + + let pp ppf x = Yaml.pp ppf (to_yaml x) + include Printable.SimpleFormat (struct + type nonrec t = t + let pp = pp + end) end From 34277e041b43c093d2d635a586e10686c35a3f8e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 11:24:42 +0200 Subject: [PATCH 126/157] Use sets instead of BatList.mem_cmp for deduplicating ghost witness variables --- src/analyses/mutexGhosts.ml | 19 ++++++------------- src/witness/yamlWitness.ml | 19 ++++++++++--------- 2 files changed, 16 insertions(+), 22 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 87e7281028..6542ab3607 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -114,6 +114,8 @@ struct let ghost_var_available ctx v = WitnessGhost.enabled () && ghost_var_available ctx v + module VariableSet = Set.Make (YamlWitnessType.GhostInstrumentation.Variable) + let query ctx (type a) (q: a Queries.t): a Queries.result = match q with | GhostVarAvailable v -> ghost_var_available ctx v @@ -173,15 +175,11 @@ struct let (variables, location_updates) = NodeSet.fold (fun node (variables, location_updates) -> let (locked, unlocked, multithread) = G.node (ctx.global (V.node node)) in let variables' = - (* TODO: do variable_entry-s only once *) Locked.fold (fun l acc -> match mustlock_of_addr l with | Some l when ghost_var_available ctx (Locked l) -> let variable = WitnessGhost.variable' (Locked l) in - if BatList.mem_cmp YamlWitnessType.GhostInstrumentation.Variable.compare variable acc then (* TODO: be efficient *) - acc - else - variable :: acc + VariableSet.add variable acc | _ -> acc ) (Locked.union locked unlocked) variables @@ -211,12 +209,7 @@ struct if ghost_var_available ctx Multithreaded then ( let variable = WitnessGhost.variable' Multithreaded in let update = WitnessGhost.update' Multithreaded GoblintCil.one in - let variables' = - if BatList.mem_cmp YamlWitnessType.GhostInstrumentation.Variable.compare variable variables' then (* TODO: be efficient *) - variables' - else - variable :: variables' - in + let variables' = VariableSet.add variable variables' in (variables', update :: updates) ) else @@ -227,9 +220,9 @@ struct in let location_update = WitnessGhost.location_update' ~node ~updates in (variables', location_update :: location_updates) - ) nodes ([], []) + ) nodes (VariableSet.empty, []) in - let entry = WitnessGhost.instrumentation_entry ~task ~variables ~location_updates in + let entry = WitnessGhost.instrumentation_entry ~task ~variables:(VariableSet.elements variables) ~location_updates in Queries.YS.singleton entry | `Left _ -> Queries.Result.top q | `Middle _ -> Queries.Result.top q diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index ec83fa04fb..a044750a79 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -398,23 +398,24 @@ struct (* Generate flow-insensitive entries (ghost variables and ghost updates) *) let entries = if (entry_type_enabled YamlWitnessType.GhostVariable.entry_type && entry_type_enabled YamlWitnessType.GhostUpdate.entry_type) || entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type then ( - GHT.fold (fun g v acc -> + let module EntrySet = Queries.YS in + fst @@ GHT.fold (fun g v accs -> match g with | `Left g -> (* Spec global *) begin match R.ask_global (YamlEntryGlobal (Obj.repr g, task)) with | `Lifted _ as inv -> - Queries.YS.fold (fun entry acc -> - if BatList.mem_cmp YamlWitnessType.Entry.compare entry acc then (* TODO: be efficient *) - acc + Queries.YS.fold (fun entry (acc, acc') -> + if EntrySet.mem entry acc' then (* deduplicate only with other global entries because local ones have different locations anyway *) + accs else - entry :: acc - ) inv acc + (entry :: acc, EntrySet.add entry acc') + ) inv accs | `Top -> - acc + accs end | `Right _ -> (* contexts global *) - acc - ) gh entries + accs + ) gh (entries, EntrySet.empty ()) ) else entries From 7929d633ee5dc3e30c3607596850bcb64995352f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 11:48:58 +0200 Subject: [PATCH 127/157] Extract fold_flow_insensitive_as_location in YamlWitness to deduplicate code --- src/witness/yamlWitness.ml | 56 ++++++++++++++++++-------------------- 1 file changed, 26 insertions(+), 30 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index a044750a79..b0ffac5852 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -353,6 +353,22 @@ struct let invariant_global_nodes = lazy (R.ask_global InvariantGlobalNodes) in + let fold_flow_insensitive_as_location ~inv f acc = + (* TODO: or do at location_invariant loop for each node and query if should also do global invariants there? *) + let invs = WitnessUtil.InvariantExp.process_exp inv in + Queries.NS.fold (fun n acc -> + let fundec = Node.find_fundec n in + match WitnessInvariant.location_location n with (* if after thread create node happens to be loop node *) + | Some loc -> + let location_function = fundec.svar.vname in + let location = Entry.location ~location:loc ~location_function in + List.fold_left (fun acc inv -> + f ~location ~inv acc + ) acc invs + | None -> acc + ) (Lazy.force invariant_global_nodes) acc + in + (* Generate flow-insensitive invariants *) let entries = if entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type then ( @@ -368,21 +384,11 @@ struct entry :: acc ) acc invs | `Lifted inv, "location_invariant" -> - (* TODO: or do at location_invariant loop for each node and query if should also do global invariants there? *) - let invs = WitnessUtil.InvariantExp.process_exp inv in - Queries.NS.fold (fun n acc -> - let fundec = Node.find_fundec n in - match WitnessInvariant.location_location n with (* if after thread create node happens to be loop node *) - | Some loc -> - let location_function = fundec.svar.vname in - let location = Entry.location ~location:loc ~location_function in - List.fold_left (fun acc inv -> - let invariant = Entry.invariant (CilType.Exp.show inv) in - let entry = Entry.location_invariant ~task ~location ~invariant in - entry :: acc - ) acc invs - | None -> acc - ) (Lazy.force invariant_global_nodes) acc + fold_flow_insensitive_as_location ~inv (fun ~location ~inv acc -> + let invariant = Entry.invariant (CilType.Exp.show inv) in + let entry = Entry.location_invariant ~task ~location ~invariant in + entry :: acc + ) acc | `Lifted _, _ | `Bot, _ | `Top, _ -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc @@ -595,21 +601,11 @@ struct | `Left g -> (* Spec global *) begin match R.ask_global (InvariantGlobal (Obj.repr g)) with | `Lifted inv -> - (* TODO: or do at location_invariant loop for each node and query if should also do global invariants there? *) - let invs = WitnessUtil.InvariantExp.process_exp inv in - Queries.NS.fold (fun n acc -> - let fundec = Node.find_fundec n in - match WitnessInvariant.location_location n with (* if after thread create node happens to be loop node *) - | Some loc -> - let location_function = fundec.svar.vname in - let location = Entry.location ~location:loc ~location_function in - List.fold_left (fun acc inv -> - let invariant = CilType.Exp.show inv in - let invariant = Entry.location_invariant' ~location ~invariant in - invariant :: acc - ) acc invs - | None -> acc - ) (Lazy.force invariant_global_nodes) acc + fold_flow_insensitive_as_location ~inv (fun ~location ~inv acc -> + let invariant = CilType.Exp.show inv in + let invariant = Entry.location_invariant' ~location ~invariant in + invariant :: acc + ) acc | `Bot | `Top -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc end From 8a0240ddb8753ab6e40691c301550c602fe821cb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 12:08:02 +0200 Subject: [PATCH 128/157] Update ghost witness related TODOs and comments --- src/analyses/apron/relationPriv.apron.ml | 2 +- src/analyses/basePriv.ml | 2 +- src/witness/yamlWitness.ml | 18 ++++++++++-------- 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index abaaa0d9b8..02ebe4d0e6 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -747,7 +747,7 @@ struct else Invariant.none | g -> (* global *) - Invariant.none (* TODO: ? *) + Invariant.none (* Could output unprotected one-variable (so non-relational) invariants, but probably not very useful. [BasePriv] does those anyway. *) end (** May written variables. *) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 7a67d0e0fc..c46492b7c7 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -891,7 +891,7 @@ struct else if VD.equal (getg (V.protected g')) (getg (V.unprotected g')) then Invariant.none (* don't output protected invariant because it's the same as unprotected *) else ( - let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: this takes protected values of everything *) + let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: This takes protected values of every [g], not just [g'], which might be unsound with pointers. See: https://github.com/goblint/analyzer/pull/1394#discussion_r1698136411. *) (* Very conservative about multiple (write-)protecting mutexes: invariant is not claimed when any of them is held. It should be possible to be more precise because writes only happen with all of them held, but conjunction is unsound when one of the mutexes is temporarily unlocked. diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index b0ffac5852..159892fd20 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -354,11 +354,13 @@ struct let invariant_global_nodes = lazy (R.ask_global InvariantGlobalNodes) in let fold_flow_insensitive_as_location ~inv f acc = - (* TODO: or do at location_invariant loop for each node and query if should also do global invariants there? *) + (* Currently same invariants (from InvariantGlobal query) for all nodes (from InvariantGlobalNodes query). + The alternative would be querying InvariantGlobal per local unknown when looping over them to generate location invariants. + See: https://github.com/goblint/analyzer/pull/1394#discussion_r1698149514. *) let invs = WitnessUtil.InvariantExp.process_exp inv in Queries.NS.fold (fun n acc -> let fundec = Node.find_fundec n in - match WitnessInvariant.location_location n with (* if after thread create node happens to be loop node *) + match WitnessInvariant.location_location n with (* Not just using Node.location because it returns expression location which may be invalid for location invariant (e.g. inside conditional). *) | Some loc -> let location_function = fundec.svar.vname in let location = Entry.location ~location:loc ~location_function in @@ -374,7 +376,7 @@ struct if entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type then ( GHT.fold (fun g v acc -> match g with - | `Left g -> (* Spec global *) + | `Left g -> (* global unknown from analysis Spec *) begin match R.ask_global (InvariantGlobal (Obj.repr g)), GobConfig.get_string "witness.invariant.flow_insensitive-as" with | `Lifted inv, "flow_insensitive_invariant" -> let invs = WitnessUtil.InvariantExp.process_exp inv in @@ -393,7 +395,7 @@ struct | `Bot, _ | `Top, _ -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc end - | `Right _ -> (* contexts global *) + | `Right _ -> (* global unknown for FromSpec contexts *) acc ) gh entries ) @@ -407,7 +409,7 @@ struct let module EntrySet = Queries.YS in fst @@ GHT.fold (fun g v accs -> match g with - | `Left g -> (* Spec global *) + | `Left g -> (* global unknown from analysis Spec *) begin match R.ask_global (YamlEntryGlobal (Obj.repr g, task)) with | `Lifted _ as inv -> Queries.YS.fold (fun entry (acc, acc') -> @@ -419,7 +421,7 @@ struct | `Top -> accs end - | `Right _ -> (* contexts global *) + | `Right _ -> (* global unknown for FromSpec contexts *) accs ) gh (entries, EntrySet.empty ()) ) @@ -598,7 +600,7 @@ struct if entry_type_enabled YamlWitnessType.FlowInsensitiveInvariant.entry_type && GobConfig.get_string "witness.invariant.flow_insensitive-as" = "invariant_set-location_invariant" then ( GHT.fold (fun g v acc -> match g with - | `Left g -> (* Spec global *) + | `Left g -> (* global unknown from analysis Spec *) begin match R.ask_global (InvariantGlobal (Obj.repr g)) with | `Lifted inv -> fold_flow_insensitive_as_location ~inv (fun ~location ~inv acc -> @@ -609,7 +611,7 @@ struct | `Bot | `Top -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) acc end - | `Right _ -> (* contexts global *) + | `Right _ -> (* global unknown for FromSpec contexts *) acc ) gh invariants ) From 64c11c2748d2981346d909392423fde938c8ca8c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 16:10:36 +0200 Subject: [PATCH 129/157] Add test 56-witness/69-ghost-ptr-protection for unsound protection flow-sensitive invariant --- .../56-witness/69-ghost-ptr-protection.c | 30 ++++++ .../56-witness/69-ghost-ptr-protection.t | 101 ++++++++++++++++++ 2 files changed, 131 insertions(+) create mode 100644 tests/regression/56-witness/69-ghost-ptr-protection.c create mode 100644 tests/regression/56-witness/69-ghost-ptr-protection.t diff --git a/tests/regression/56-witness/69-ghost-ptr-protection.c b/tests/regression/56-witness/69-ghost-ptr-protection.c new file mode 100644 index 0000000000..f5557f3fc8 --- /dev/null +++ b/tests/regression/56-witness/69-ghost-ptr-protection.c @@ -0,0 +1,30 @@ +// PARAM: --set ana.activated[+] mutexGhosts +// CRAM +#include +#include + +int g = 0; +int *p = &g; +pthread_mutex_t m1 = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t m2 = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + int x = 10; + pthread_mutex_lock(&m2); + p = &x; + p = &g; + pthread_mutex_unlock(&m2); + return NULL; +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + pthread_mutex_lock(&m1); + g = 1; + // m2_locked || (p == & g && *p == 0) would be violated here + __goblint_check(*p != 0); // 1 from g or 10 from x in t_fun + g = 0; + pthread_mutex_unlock(&m1); + return 0; +} diff --git a/tests/regression/56-witness/69-ghost-ptr-protection.t b/tests/regression/56-witness/69-ghost-ptr-protection.t new file mode 100644 index 0000000000..03481a7ce1 --- /dev/null +++ b/tests/regression/56-witness/69-ghost-ptr-protection.t @@ -0,0 +1,101 @@ + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 69-ghost-ptr-protection.c + [Success][Assert] Assertion "*p != 0" will succeed (69-ghost-ptr-protection.c:26:3-26:27) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 15 + dead: 0 + total lines: 15 + [Warning][Race] Memory location p (race with conf. 110): (69-ghost-ptr-protection.c:7:5-7:12) + write with [lock:{m2}, thread:[main, t_fun@69-ghost-ptr-protection.c:22:3-22:40]] (conf. 110) (exp: & p) (69-ghost-ptr-protection.c:14:3-14:9) + write with [lock:{m2}, thread:[main, t_fun@69-ghost-ptr-protection.c:22:3-22:40]] (conf. 110) (exp: & p) (69-ghost-ptr-protection.c:15:3-15:9) + read with [mhp:{created={[main, t_fun@69-ghost-ptr-protection.c:22:3-22:40]}}, lock:{m1}, thread:[main]] (conf. 110) (exp: & p) (69-ghost-ptr-protection.c:26:3-26:27) + [Info][Witness] witness generation summary: + total generation entries: 12 + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 1 + total memory locations: 3 + +TODO: Should not contain unsound flow-insensitive invariant m2_locked || (p == & g && *p == 0): + + $ yamlWitnessStrip < witness.yml + - entry_type: ghost_update + variable: multithreaded + expression: "1" + location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: main + - entry_type: ghost_update + variable: m2_locked + expression: "1" + location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m2_locked + expression: "0" + location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 16 + column: 3 + function: t_fun + - entry_type: ghost_update + variable: m1_locked + expression: "1" + location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + - entry_type: ghost_update + variable: m1_locked + expression: "0" + location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + - entry_type: ghost_variable + variable: multithreaded + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m2_locked + scope: global + type: int + initial: "0" + - entry_type: ghost_variable + variable: m1_locked + scope: global + type: int + initial: "0" + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m2_locked || (p == & g && *p == 0))' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (m1_locked || g == 0)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (0 <= g && g <= 1)' + type: assertion + format: C + - entry_type: flow_insensitive_invariant + flow_insensitive_invariant: + string: '! multithreaded || (*p == 10 || ((0 <= *p && *p <= 1) && p == & g))' + type: assertion + format: C From b4734c31753b328b74283f9f82351fd6e09979c9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 16:22:33 +0200 Subject: [PATCH 130/157] Fix unsound ghost witness invariant in 56-witness/69-ghost-ptr-protection --- src/analyses/basePriv.ml | 5 ++++- tests/regression/56-witness/69-ghost-ptr-protection.t | 4 ++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index b7e32ceb94..3afd758daa 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -891,7 +891,10 @@ struct else if VD.equal (getg (V.protected g')) (getg (V.unprotected g')) then Invariant.none (* don't output protected invariant because it's the same as unprotected *) else ( - let inv = ValueDomain.invariant_global (fun g -> getg (V.protected g)) g' in (* TODO: This takes protected values of every [g], not just [g'], which might be unsound with pointers. See: https://github.com/goblint/analyzer/pull/1394#discussion_r1698136411. *) + (* Only read g' as protected, everything else (e.g. pointed to variables) may be unprotected. + See 56-witness/69-ghost-ptr-protection and https://github.com/goblint/analyzer/pull/1394#discussion_r1698136411. *) + let read_global g = getg (if CilType.Varinfo.equal g g' then V.protected g else V.unprotected g) in + let inv = ValueDomain.invariant_global read_global g' in (* Very conservative about multiple (write-)protecting mutexes: invariant is not claimed when any of them is held. It should be possible to be more precise because writes only happen with all of them held, but conjunction is unsound when one of the mutexes is temporarily unlocked. diff --git a/tests/regression/56-witness/69-ghost-ptr-protection.t b/tests/regression/56-witness/69-ghost-ptr-protection.t index 03481a7ce1..698f643385 100644 --- a/tests/regression/56-witness/69-ghost-ptr-protection.t +++ b/tests/regression/56-witness/69-ghost-ptr-protection.t @@ -16,7 +16,7 @@ unsafe: 1 total memory locations: 3 -TODO: Should not contain unsound flow-insensitive invariant m2_locked || (p == & g && *p == 0): +Should not contain unsound flow-insensitive invariant m2_locked || (p == & g && *p == 0): $ yamlWitnessStrip < witness.yml - entry_type: ghost_update @@ -81,7 +81,7 @@ TODO: Should not contain unsound flow-insensitive invariant m2_locked || (p == & initial: "0" - entry_type: flow_insensitive_invariant flow_insensitive_invariant: - string: '! multithreaded || (m2_locked || (p == & g && *p == 0))' + string: '! multithreaded || (m2_locked || ((0 <= *p && *p <= 1) && p == & g))' type: assertion format: C - entry_type: flow_insensitive_invariant From d2e71cbbf773205abb600fc15cf07ba712a2e6eb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 16:58:43 +0200 Subject: [PATCH 131/157] Change ghost witness tests to use ghost_instrumentation --- .../regression/13-privatized/04-priv_multi.t | 298 +++---- tests/regression/13-privatized/25-struct_nr.t | 125 +-- tests/regression/13-privatized/74-mutex.t | 258 +++--- tests/regression/13-privatized/92-idx_priv.t | 66 +- tests/regression/29-svcomp/16-atomic_priv.t | 76 +- .../regression/36-apron/12-traces-min-rpb1.t | 163 ++-- .../56-witness/64-ghost-multiple-protecting.t | 750 ++++++++++-------- .../56-witness/65-ghost-ambiguous-lock.t | 94 ++- .../56-witness/66-ghost-alloc-lock.t | 212 ++--- .../56-witness/67-ghost-no-unlock.t | 106 +-- .../56-witness/68-ghost-ambiguous-idx.t | 66 +- .../56-witness/69-ghost-ptr-protection.t | 136 ++-- 12 files changed, 1325 insertions(+), 1025 deletions(-) diff --git a/tests/regression/13-privatized/04-priv_multi.t b/tests/regression/13-privatized/04-priv_multi.t index fd0dad6a39..3ea9b385fc 100644 --- a/tests/regression/13-privatized/04-priv_multi.t +++ b/tests/regression/13-privatized/04-priv_multi.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 04-priv_multi.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 04-priv_multi.c [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) [Warning][Deadcode] Function 'dispose' has dead code: @@ -16,7 +16,7 @@ [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (04-priv_multi.c:45:10-45:11) [Warning][Deadcode][CWE-571] condition 'B > 0' is always true (04-priv_multi.c:47:9-47:14) [Info][Witness] witness generation summary: - total generation entries: 19 + total generation entries: 4 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -24,138 +24,158 @@ total memory locations: 2 $ yamlWitnessStrip < witness.yml | tee witness.flow_insensitive.yml - - entry_type: ghost_update - variable: mutex_B_locked - expression: "1" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 69 - column: 5 - function: main - - entry_type: ghost_update - variable: mutex_B_locked - expression: "1" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 46 - column: 5 - function: dispose - - entry_type: ghost_update - variable: mutex_B_locked - expression: "1" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 29 - column: 7 - function: process - - entry_type: ghost_update - variable: mutex_B_locked - expression: "0" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 73 - column: 5 - function: main - - entry_type: ghost_update - variable: mutex_B_locked - expression: "0" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 49 - column: 7 - function: dispose - - entry_type: ghost_update - variable: mutex_B_locked - expression: "0" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 32 - column: 7 - function: process - - entry_type: ghost_update - variable: mutex_A_locked - expression: "1" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 68 - column: 5 - function: main - - entry_type: ghost_update - variable: mutex_A_locked - expression: "1" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 26 - column: 5 - function: process - - entry_type: ghost_update - variable: mutex_A_locked - expression: "1" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 15 - column: 5 - function: generate - - entry_type: ghost_update - variable: mutex_A_locked - expression: "0" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 74 - column: 5 - function: main - - entry_type: ghost_update - variable: mutex_A_locked - expression: "0" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 34 - column: 7 - function: process - - entry_type: ghost_update - variable: mutex_A_locked - expression: "0" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 18 - column: 5 - function: generate - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 04-priv_multi.c - file_hash: $FILE_HASH - line: 63 - column: 3 - function: main - - entry_type: ghost_variable - variable: mutex_B_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: mutex_A_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: mutex_A_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: mutex_B_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 15 + column: 5 + function: generate + updates: + - variable: mutex_A_locked + value: "1" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 18 + column: 5 + function: generate + updates: + - variable: mutex_A_locked + value: "0" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 26 + column: 5 + function: process + updates: + - variable: mutex_A_locked + value: "1" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 29 + column: 7 + function: process + updates: + - variable: mutex_B_locked + value: "1" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 32 + column: 7 + function: process + updates: + - variable: mutex_B_locked + value: "0" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 34 + column: 7 + function: process + updates: + - variable: mutex_A_locked + value: "0" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 46 + column: 5 + function: dispose + updates: + - variable: mutex_B_locked + value: "1" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 49 + column: 7 + function: dispose + updates: + - variable: mutex_B_locked + value: "0" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 63 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 68 + column: 5 + function: main + updates: + - variable: mutex_A_locked + value: "1" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 69 + column: 5 + function: main + updates: + - variable: mutex_B_locked + value: "1" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 73 + column: 5 + function: main + updates: + - variable: mutex_B_locked + value: "0" + format: c_expression + - location: + file_name: 04-priv_multi.c + file_hash: $FILE_HASH + line: 74 + column: 5 + function: main + updates: + - variable: mutex_A_locked + value: "0" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (mutex_B_locked || (mutex_A_locked || B == 5))' @@ -174,7 +194,7 @@ Flow-insensitive invariants as location invariants. - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --set witness.invariant.flow_insensitive-as location_invariant 04-priv_multi.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' --set witness.invariant.flow_insensitive-as location_invariant 04-priv_multi.c [Success][Assert] Assertion "p == 5" will succeed (04-priv_multi.c:50:7-50:30) [Success][Assert] Assertion "A == B" will succeed (04-priv_multi.c:71:5-71:28) [Warning][Deadcode] Function 'dispose' has dead code: @@ -192,7 +212,7 @@ Flow-insensitive invariants as location invariants. [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (04-priv_multi.c:45:10-45:11) [Warning][Deadcode][CWE-571] condition 'B > 0' is always true (04-priv_multi.c:47:9-47:14) [Info][Witness] witness generation summary: - total generation entries: 25 + total generation entries: 10 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -204,7 +224,7 @@ Flow-insensitive invariants as location invariants. Location invariant at `for` loop in `main` should be on column 3, not 7. $ diff witness.flow_insensitive.yml witness.location.yml - 133,134c133,140 + 153,154c153,160 < - entry_type: flow_insensitive_invariant < flow_insensitive_invariant: --- @@ -216,7 +236,7 @@ Location invariant at `for` loop in `main` should be on column 3, not 7. > column: 3 > function: main > location_invariant: - 138,139c144,151 + 158,159c164,171 < - entry_type: flow_insensitive_invariant < flow_insensitive_invariant: --- @@ -228,7 +248,7 @@ Location invariant at `for` loop in `main` should be on column 3, not 7. > column: 3 > function: main > location_invariant: - 143,144c155,228 + 163,164c175,248 < - entry_type: flow_insensitive_invariant < flow_insensitive_invariant: --- diff --git a/tests/regression/13-privatized/25-struct_nr.t b/tests/regression/13-privatized/25-struct_nr.t index 88f205a431..59ed9960f2 100644 --- a/tests/regression/13-privatized/25-struct_nr.t +++ b/tests/regression/13-privatized/25-struct_nr.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 25-struct_nr.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 25-struct_nr.c [Success][Assert] Assertion "glob1 == 5" will succeed (25-struct_nr.c:26:3-26:30) [Success][Assert] Assertion "t == 5" will succeed (25-struct_nr.c:16:3-16:26) [Success][Assert] Assertion "glob1 == -10" will succeed (25-struct_nr.c:18:3-18:32) @@ -8,7 +8,7 @@ dead: 0 total lines: 19 [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -16,61 +16,72 @@ total memory locations: 1 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 25-struct_nr.c - file_hash: $FILE_HASH - line: 27 - column: 3 - function: main - - entry_type: ghost_update - variable: lock1_mutex_locked - expression: "1" - location: - file_name: 25-struct_nr.c - file_hash: $FILE_HASH - line: 28 - column: 3 - function: main - - entry_type: ghost_update - variable: lock1_mutex_locked - expression: "1" - location: - file_name: 25-struct_nr.c - file_hash: $FILE_HASH - line: 14 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: lock1_mutex_locked - expression: "0" - location: - file_name: 25-struct_nr.c - file_hash: $FILE_HASH - line: 32 - column: 3 - function: main - - entry_type: ghost_update - variable: lock1_mutex_locked - expression: "0" - location: - file_name: 25-struct_nr.c - file_hash: $FILE_HASH - line: 20 - column: 3 - function: t_fun - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: lock1_mutex_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: lock1_mutex_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + updates: + - variable: lock1_mutex_locked + value: "1" + format: c_expression + - location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: t_fun + updates: + - variable: lock1_mutex_locked + value: "0" + format: c_expression + - location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 27 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + updates: + - variable: lock1_mutex_locked + value: "1" + format: c_expression + - location: + file_name: 25-struct_nr.c + file_hash: $FILE_HASH + line: 32 + column: 3 + function: main + updates: + - variable: lock1_mutex_locked + value: "0" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (lock1_mutex_locked || glob1 == 5)' diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 8a1a7fee5f..1c1f0c12be 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -8,7 +8,7 @@ total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -16,61 +16,72 @@ total memory locations: 1 $ yamlWitnessStrip < witness.yml | tee witness.flow_insensitive.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 34 - column: 3 - function: main - - entry_type: ghost_update - variable: m_locked - expression: "1" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 36 - column: 3 - function: main - - entry_type: ghost_update - variable: m_locked - expression: "1" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 20 - column: 5 - function: producer - - entry_type: ghost_update - variable: m_locked - expression: "0" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 38 - column: 3 - function: main - - entry_type: ghost_update - variable: m_locked - expression: "0" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 23 - column: 5 - function: producer - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: m_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 20 + column: 5 + function: producer + updates: + - variable: m_locked + value: "1" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 23 + column: 5 + function: producer + updates: + - variable: m_locked + value: "0" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 34 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 3 + function: main + updates: + - variable: m_locked + value: "1" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 38 + column: 3 + function: main + updates: + - variable: m_locked + value: "0" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (m_locked || used == 0)' @@ -84,7 +95,7 @@ Flow-insensitive invariants as location invariants. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' --set witness.invariant.flow_insensitive-as location_invariant 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' --set witness.invariant.flow_insensitive-as location_invariant 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -94,7 +105,7 @@ Flow-insensitive invariants as location invariants. total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -104,7 +115,7 @@ Flow-insensitive invariants as location invariants. $ yamlWitnessStrip < witness.yml > witness.location.yml $ diff witness.flow_insensitive.yml witness.location.yml - 56,57c56,63 + 67,68c67,74 < - entry_type: flow_insensitive_invariant < flow_insensitive_invariant: --- @@ -116,7 +127,7 @@ Flow-insensitive invariants as location invariants. > column: 3 > function: main > location_invariant: - 61,62c67,74 + 72,73c78,85 < - entry_type: flow_insensitive_invariant < flow_insensitive_invariant: --- @@ -259,7 +270,7 @@ Same with ghost_instrumentation and invariant_set entries. Same with mutex-meet. - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 74-mutex.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 74-mutex.c [Success][Assert] Assertion "used == 0" will succeed (74-mutex.c:37:3-37:29) [Warning][Deadcode] Function 'producer' has dead code: on line 26 (74-mutex.c:26-26) @@ -269,7 +280,7 @@ Same with mutex-meet. total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: - total generation entries: 9 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -277,61 +288,72 @@ Same with mutex-meet. total memory locations: 1 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 34 - column: 3 - function: main - - entry_type: ghost_update - variable: m_locked - expression: "1" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 36 - column: 3 - function: main - - entry_type: ghost_update - variable: m_locked - expression: "1" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 20 - column: 5 - function: producer - - entry_type: ghost_update - variable: m_locked - expression: "0" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 38 - column: 3 - function: main - - entry_type: ghost_update - variable: m_locked - expression: "0" - location: - file_name: 74-mutex.c - file_hash: $FILE_HASH - line: 23 - column: 5 - function: producer - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: m_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 20 + column: 5 + function: producer + updates: + - variable: m_locked + value: "1" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 23 + column: 5 + function: producer + updates: + - variable: m_locked + value: "0" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 34 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 36 + column: 3 + function: main + updates: + - variable: m_locked + value: "1" + format: c_expression + - location: + file_name: 74-mutex.c + file_hash: $FILE_HASH + line: 38 + column: 3 + function: main + updates: + - variable: m_locked + value: "0" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (m_locked || used == 0)' diff --git a/tests/regression/13-privatized/92-idx_priv.t b/tests/regression/13-privatized/92-idx_priv.t index b157dfed4b..4783f65092 100644 --- a/tests/regression/13-privatized/92-idx_priv.t +++ b/tests/regression/13-privatized/92-idx_priv.t @@ -1,11 +1,11 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 92-idx_priv.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 92-idx_priv.c [Success][Assert] Assertion "data == 0" will succeed (92-idx_priv.c:22:3-22:29) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 14 dead: 0 total lines: 14 [Info][Witness] witness generation summary: - total generation entries: 3 + total generation entries: 2 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -13,20 +13,54 @@ total memory locations: 1 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 92-idx_priv.c - file_hash: $FILE_HASH - line: 20 - column: 3 - function: main - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 92-idx_priv.c + file_hash: $FILE_HASH + line: 8 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 92-idx_priv.c + file_hash: $FILE_HASH + line: 11 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 92-idx_priv.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 92-idx_priv.c + file_hash: $FILE_HASH + line: 21 + column: 3 + function: main + updates: [] + - location: + file_name: 92-idx_priv.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + updates: [] - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= data && data <= 1)' diff --git a/tests/regression/29-svcomp/16-atomic_priv.t b/tests/regression/29-svcomp/16-atomic_priv.t index eea47295d5..92afedcd27 100644 --- a/tests/regression/29-svcomp/16-atomic_priv.t +++ b/tests/regression/29-svcomp/16-atomic_priv.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection-atomic --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection-atomic --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 16-atomic_priv.c [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) @@ -13,7 +13,7 @@ write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:15:3-15:13) read with [mhp:{created={[main, t_fun@16-atomic_priv.c:23:3-23:40]}}, thread:[main]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:24:3-24:33) [Info][Witness] witness generation summary: - total generation entries: 3 + total generation entries: 2 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 @@ -21,20 +21,26 @@ total memory locations: 1 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: main - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || myglobal == 5' @@ -43,7 +49,7 @@ Non-atomic privatization: - $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 16-atomic_priv.c + $ goblint --enable ana.sv-comp.functions --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 16-atomic_priv.c [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:12:3-12:33) [Success][Assert] Assertion "myglobal == 6" will succeed (16-atomic_priv.c:14:3-14:33) [Success][Assert] Assertion "myglobal == 5" will succeed (16-atomic_priv.c:16:3-16:33) @@ -58,7 +64,7 @@ Non-atomic privatization: write with [lock:{[__VERIFIER_atomic]}, thread:[main, t_fun@16-atomic_priv.c:23:3-23:40]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:15:3-15:13) read with [mhp:{created={[main, t_fun@16-atomic_priv.c:23:3-23:40]}}, thread:[main]] (conf. 110) (exp: & myglobal) (16-atomic_priv.c:24:3-24:33) [Info][Witness] witness generation summary: - total generation entries: 4 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 @@ -66,20 +72,26 @@ Non-atomic privatization: total memory locations: 1 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 16-atomic_priv.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: main - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 16-atomic_priv.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || myglobal == 5' diff --git a/tests/regression/36-apron/12-traces-min-rpb1.t b/tests/regression/36-apron/12-traces-min-rpb1.t index 8201b2f8f9..c0ae5c118e 100644 --- a/tests/regression/36-apron/12-traces-min-rpb1.t +++ b/tests/regression/36-apron/12-traces-min-rpb1.t @@ -56,7 +56,7 @@ format: C - $ goblint --enable warn.deterministic --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box + $ goblint --enable warn.deterministic --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 12-traces-min-rpb1.c --enable ana.apron.invariant.diff-box [Warning][Assert] Assertion "g == h" is unknown. (12-traces-min-rpb1.c:27:3-27:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:16:3-16:26) [Success][Assert] Assertion "g == h" will succeed (12-traces-min-rpb1.c:29:3-29:26) @@ -76,82 +76,95 @@ dead: 0 total lines: 18 [Info][Witness] witness generation summary: - total generation entries: 10 + total generation entries: 2 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 12-traces-min-rpb1.c - file_hash: $FILE_HASH - line: 25 - column: 3 - function: main - - entry_type: ghost_update - variable: A_locked - expression: "1" - location: - file_name: 12-traces-min-rpb1.c - file_hash: $FILE_HASH - line: 28 - column: 3 - function: main - - entry_type: ghost_update - variable: A_locked - expression: "1" - location: - file_name: 12-traces-min-rpb1.c - file_hash: $FILE_HASH - line: 18 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: A_locked - expression: "1" - location: - file_name: 12-traces-min-rpb1.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: A_locked - expression: "0" - location: - file_name: 12-traces-min-rpb1.c - file_hash: $FILE_HASH - line: 30 - column: 3 - function: main - - entry_type: ghost_update - variable: A_locked - expression: "0" - location: - file_name: 12-traces-min-rpb1.c - file_hash: $FILE_HASH - line: 19 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: A_locked - expression: "0" - location: - file_name: 12-traces-min-rpb1.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: A_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: A_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + updates: + - variable: A_locked + value: "1" + format: c_expression + - location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + updates: + - variable: A_locked + value: "0" + format: c_expression + - location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 18 + column: 3 + function: t_fun + updates: + - variable: A_locked + value: "1" + format: c_expression + - location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 19 + column: 3 + function: t_fun + updates: + - variable: A_locked + value: "0" + format: c_expression + - location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 25 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + updates: + - variable: A_locked + value: "1" + format: c_expression + - location: + file_name: 12-traces-min-rpb1.c + file_hash: $FILE_HASH + line: 30 + column: 3 + function: main + updates: + - variable: A_locked + value: "0" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (A_locked || ((0LL - (long long )g) + (long long )h diff --git a/tests/regression/56-witness/64-ghost-multiple-protecting.t b/tests/regression/56-witness/64-ghost-multiple-protecting.t index e78d0d75aa..73863eecac 100644 --- a/tests/regression/56-witness/64-ghost-multiple-protecting.t +++ b/tests/regression/56-witness/64-ghost-multiple-protecting.t @@ -1,10 +1,10 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 total lines: 19 [Info][Witness] witness generation summary: - total generation entries: 17 + total generation entries: 4 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -14,120 +14,138 @@ protection doesn't have precise protected invariant for g2. $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 29 - column: 3 - function: main - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 20 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 10 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 22 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 19 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 16 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 9 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 14 - column: 3 - function: t_fun - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m2_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m1_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: m1_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: m2_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 9 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 10 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 16 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 19 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 29 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (m2_locked || (m1_locked || g1 == 0))' @@ -144,13 +162,13 @@ protection doesn't have precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization protection-read --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 total lines: 19 [Info][Witness] witness generation summary: - total generation entries: 18 + total generation entries: 5 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -160,120 +178,138 @@ protection doesn't have precise protected invariant for g2. protection-read has precise protected invariant for g2. $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 29 - column: 3 - function: main - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 20 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 10 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 22 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 19 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 16 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 9 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 14 - column: 3 - function: t_fun - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m2_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m1_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: m1_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: m2_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 9 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 10 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 16 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 19 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 29 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (m2_locked || (m1_locked || g2 == 0))' @@ -295,13 +331,13 @@ protection-read has precise protected invariant for g2. type: assertion format: C - $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 64-ghost-multiple-protecting.c + $ goblint --set ana.base.privatization mutex-meet --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 64-ghost-multiple-protecting.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 19 dead: 0 total lines: 19 [Info][Witness] witness generation summary: - total generation entries: 18 + total generation entries: 5 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -309,120 +345,138 @@ protection-read has precise protected invariant for g2. total memory locations: 2 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 29 - column: 3 - function: main - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 20 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 10 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 22 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 19 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 16 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 9 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 64-ghost-multiple-protecting.c - file_hash: $FILE_HASH - line: 14 - column: 3 - function: t_fun - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m2_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m1_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: m1_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: m2_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 9 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 10 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 16 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 19 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "0" + format: c_expression + - location: + file_name: 64-ghost-multiple-protecting.c + file_hash: $FILE_HASH + line: 29 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (m2_locked || ((0 <= g2 && g2 <= 1) && g1 == 0))' diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.t b/tests/regression/56-witness/65-ghost-ambiguous-lock.t index a6e0c12b74..8115bb2921 100644 --- a/tests/regression/56-witness/65-ghost-ambiguous-lock.t +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.t @@ -1,10 +1,10 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 65-ghost-ambiguous-lock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 65-ghost-ambiguous-lock.c [Info][Deadcode] Logical lines of code (LLoC) summary: live: 23 dead: 0 total lines: 23 [Info][Witness] witness generation summary: - total generation entries: 4 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -12,20 +12,82 @@ total memory locations: 2 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 29 - column: 3 - function: main - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 10 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: fun + updates: [] + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 24 + column: 3 + function: fun + updates: [] + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 29 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 35 + column: 3 + function: main + updates: [] + - location: + file_name: 65-ghost-ambiguous-lock.c + file_hash: $FILE_HASH + line: 37 + column: 3 + function: main + updates: [] - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= g2 && g2 <= 1)' diff --git a/tests/regression/56-witness/66-ghost-alloc-lock.t b/tests/regression/56-witness/66-ghost-alloc-lock.t index 8e45272538..844c1e6c15 100644 --- a/tests/regression/56-witness/66-ghost-alloc-lock.t +++ b/tests/regression/56-witness/66-ghost-alloc-lock.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.malloc.unique_address_count 1 --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 66-ghost-alloc-lock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set ana.malloc.unique_address_count 1 --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 66-ghost-alloc-lock.c [Success][Assert] Assertion "g1 == 0" will succeed (66-ghost-alloc-lock.c:31:3-31:27) [Success][Assert] Assertion "g2 == 0" will succeed (66-ghost-alloc-lock.c:34:3-34:27) [Info][Deadcode] Logical lines of code (LLoC) summary: @@ -6,7 +6,7 @@ dead: 0 total lines: 23 [Info][Witness] witness generation summary: - total generation entries: 16 + total generation entries: 5 [Info][Race] Memory locations race summary: safe: 4 vulnerable: 0 @@ -14,102 +14,118 @@ total memory locations: 4 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 28 - column: 3 - function: main - - entry_type: ghost_update - variable: alloc_m861095507_locked - expression: "1" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 33 - column: 3 - function: main - - entry_type: ghost_update - variable: alloc_m861095507_locked - expression: "1" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 14 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: alloc_m861095507_locked - expression: "0" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 35 - column: 3 - function: main - - entry_type: ghost_update - variable: alloc_m861095507_locked - expression: "0" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: alloc_m559918035_locked - expression: "1" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 30 - column: 3 - function: main - - entry_type: ghost_update - variable: alloc_m559918035_locked - expression: "1" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 10 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: alloc_m559918035_locked - expression: "0" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 32 - column: 3 - function: main - - entry_type: ghost_update - variable: alloc_m559918035_locked - expression: "0" - location: - file_name: 66-ghost-alloc-lock.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: alloc_m861095507_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: alloc_m559918035_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: alloc_m559918035_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: alloc_m861095507_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 10 + column: 3 + function: t_fun + updates: + - variable: alloc_m559918035_locked + value: "1" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + updates: + - variable: alloc_m559918035_locked + value: "0" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 14 + column: 3 + function: t_fun + updates: + - variable: alloc_m861095507_locked + value: "1" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 17 + column: 3 + function: t_fun + updates: + - variable: alloc_m861095507_locked + value: "0" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 30 + column: 3 + function: main + updates: + - variable: alloc_m559918035_locked + value: "1" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 32 + column: 3 + function: main + updates: + - variable: alloc_m559918035_locked + value: "0" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 33 + column: 3 + function: main + updates: + - variable: alloc_m861095507_locked + value: "1" + format: c_expression + - location: + file_name: 66-ghost-alloc-lock.c + file_hash: $FILE_HASH + line: 35 + column: 3 + function: main + updates: + - variable: alloc_m861095507_locked + value: "0" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (alloc_m861095507_locked || g2 == 0)' diff --git a/tests/regression/56-witness/67-ghost-no-unlock.t b/tests/regression/56-witness/67-ghost-no-unlock.t index 85b7a0b897..264d592366 100644 --- a/tests/regression/56-witness/67-ghost-no-unlock.t +++ b/tests/regression/56-witness/67-ghost-no-unlock.t @@ -1,11 +1,11 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 67-ghost-no-unlock.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 67-ghost-no-unlock.c [Success][Assert] Assertion "g1 == 0" will succeed (67-ghost-no-unlock.c:24:3-24:27) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 11 dead: 0 total lines: 11 [Info][Witness] witness generation summary: - total generation entries: 8 + total generation entries: 3 [Info][Race] Memory locations race summary: safe: 1 vulnerable: 0 @@ -13,52 +13,62 @@ total memory locations: 1 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 67-ghost-no-unlock.c - file_hash: $FILE_HASH - line: 21 - column: 3 - function: main - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 67-ghost-no-unlock.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: main - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 67-ghost-no-unlock.c - file_hash: $FILE_HASH - line: 9 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 67-ghost-no-unlock.c - file_hash: $FILE_HASH - line: 12 - column: 3 - function: t_fun - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m1_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: m1_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 9 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 12 + column: 3 + function: t_fun + updates: + - variable: m1_locked + value: "0" + format: c_expression + - location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 21 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 67-ghost-no-unlock.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + updates: + - variable: m1_locked + value: "1" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (m1_locked || g1 == 0)' diff --git a/tests/regression/56-witness/68-ghost-ambiguous-idx.t b/tests/regression/56-witness/68-ghost-ambiguous-idx.t index 02cecfd8f6..a8f2a0226a 100644 --- a/tests/regression/56-witness/68-ghost-ambiguous-idx.t +++ b/tests/regression/56-witness/68-ghost-ambiguous-idx.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 68-ghost-ambiguous-idx.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 68-ghost-ambiguous-idx.c [Warning][Assert] Assertion "data == 0" is unknown. (68-ghost-ambiguous-idx.c:24:3-24:29) [Warning][Unknown] unlocking mutex (m[4]) which may not be held (68-ghost-ambiguous-idx.c:25:3-25:30) [Info][Deadcode] Logical lines of code (LLoC) summary: @@ -10,7 +10,7 @@ write with [lock:{m[4]}, thread:[main, t_fun@68-ghost-ambiguous-idx.c:20:3-20:40]] (conf. 110) (exp: & data) (68-ghost-ambiguous-idx.c:10:3-10:9) read with [mhp:{created={[main, t_fun@68-ghost-ambiguous-idx.c:20:3-20:40]}}, thread:[main]] (conf. 110) (exp: & data) (68-ghost-ambiguous-idx.c:24:3-24:29) [Info][Witness] witness generation summary: - total generation entries: 3 + total generation entries: 2 [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 @@ -18,20 +18,54 @@ total memory locations: 1 $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 20 - column: 3 - function: main - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 8 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 11 + column: 3 + function: t_fun + updates: [] + - location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 20 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + updates: [] + - location: + file_name: 68-ghost-ambiguous-idx.c + file_hash: $FILE_HASH + line: 25 + column: 3 + function: main + updates: [] - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= data && data <= 1)' diff --git a/tests/regression/56-witness/69-ghost-ptr-protection.t b/tests/regression/56-witness/69-ghost-ptr-protection.t index 698f643385..0b28f22b0f 100644 --- a/tests/regression/56-witness/69-ghost-ptr-protection.t +++ b/tests/regression/56-witness/69-ghost-ptr-protection.t @@ -1,4 +1,4 @@ - $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_variable", "ghost_update"]' 69-ghost-ptr-protection.c + $ goblint --set ana.base.privatization protection --enable witness.yaml.enabled --set ana.activated[+] mutexGhosts --set witness.yaml.entry-types '["flow_insensitive_invariant", "ghost_instrumentation"]' 69-ghost-ptr-protection.c [Success][Assert] Assertion "*p != 0" will succeed (69-ghost-ptr-protection.c:26:3-26:27) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 15 @@ -9,7 +9,7 @@ write with [lock:{m2}, thread:[main, t_fun@69-ghost-ptr-protection.c:22:3-22:40]] (conf. 110) (exp: & p) (69-ghost-ptr-protection.c:15:3-15:9) read with [mhp:{created={[main, t_fun@69-ghost-ptr-protection.c:22:3-22:40]}}, lock:{m1}, thread:[main]] (conf. 110) (exp: & p) (69-ghost-ptr-protection.c:26:3-26:27) [Info][Witness] witness generation summary: - total generation entries: 12 + total generation entries: 5 [Info][Race] Memory locations race summary: safe: 2 vulnerable: 0 @@ -19,66 +19,78 @@ Should not contain unsound flow-insensitive invariant m2_locked || (p == & g && *p == 0): $ yamlWitnessStrip < witness.yml - - entry_type: ghost_update - variable: multithreaded - expression: "1" - location: - file_name: 69-ghost-ptr-protection.c - file_hash: $FILE_HASH - line: 22 - column: 3 - function: main - - entry_type: ghost_update - variable: m2_locked - expression: "1" - location: - file_name: 69-ghost-ptr-protection.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m2_locked - expression: "0" - location: - file_name: 69-ghost-ptr-protection.c - file_hash: $FILE_HASH - line: 16 - column: 3 - function: t_fun - - entry_type: ghost_update - variable: m1_locked - expression: "1" - location: - file_name: 69-ghost-ptr-protection.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: main - - entry_type: ghost_update - variable: m1_locked - expression: "0" - location: - file_name: 69-ghost-ptr-protection.c - file_hash: $FILE_HASH - line: 28 - column: 3 - function: main - - entry_type: ghost_variable - variable: multithreaded - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m2_locked - scope: global - type: int - initial: "0" - - entry_type: ghost_variable - variable: m1_locked - scope: global - type: int - initial: "0" + - entry_type: ghost_instrumentation + content: + ghost_variables: + - name: m1_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: m2_locked + scope: global + type: int + initial: + value: "0" + format: c_expression + - name: multithreaded + scope: global + type: int + initial: + value: "0" + format: c_expression + ghost_updates: + - location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 13 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "1" + format: c_expression + - location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 16 + column: 3 + function: t_fun + updates: + - variable: m2_locked + value: "0" + format: c_expression + - location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 22 + column: 3 + function: main + updates: + - variable: multithreaded + value: "1" + format: c_expression + - location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 23 + column: 3 + function: main + updates: + - variable: m1_locked + value: "1" + format: c_expression + - location: + file_name: 69-ghost-ptr-protection.c + file_hash: $FILE_HASH + line: 28 + column: 3 + function: main + updates: + - variable: m1_locked + value: "0" + format: c_expression - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (m2_locked || ((0 <= *p && *p <= 1) && p == & g))' From 554bd7f72e8cac3cc226976ad6f26bc434fd38d5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 17:01:40 +0200 Subject: [PATCH 132/157] Avoid empty ghost_instrumentation location updates --- src/analyses/mutexGhosts.ml | 7 ++- tests/regression/13-privatized/92-idx_priv.t | 28 ---------- .../56-witness/65-ghost-ambiguous-lock.t | 56 ------------------- .../56-witness/68-ghost-ambiguous-idx.t | 28 ---------- 4 files changed, 5 insertions(+), 114 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 6542ab3607..6ed0da4d4c 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -218,8 +218,11 @@ struct else (variables', updates) in - let location_update = WitnessGhost.location_update' ~node ~updates in - (variables', location_update :: location_updates) + match updates with + | [] -> (variables', location_updates) (* don't add location_update with no updates *) + | _ -> + let location_update = WitnessGhost.location_update' ~node ~updates in + (variables', location_update :: location_updates) ) nodes (VariableSet.empty, []) in let entry = WitnessGhost.instrumentation_entry ~task ~variables:(VariableSet.elements variables) ~location_updates in diff --git a/tests/regression/13-privatized/92-idx_priv.t b/tests/regression/13-privatized/92-idx_priv.t index 4783f65092..261108cf2f 100644 --- a/tests/regression/13-privatized/92-idx_priv.t +++ b/tests/regression/13-privatized/92-idx_priv.t @@ -23,20 +23,6 @@ value: "0" format: c_expression ghost_updates: - - location: - file_name: 92-idx_priv.c - file_hash: $FILE_HASH - line: 8 - column: 3 - function: t_fun - updates: [] - - location: - file_name: 92-idx_priv.c - file_hash: $FILE_HASH - line: 11 - column: 3 - function: t_fun - updates: [] - location: file_name: 92-idx_priv.c file_hash: $FILE_HASH @@ -47,20 +33,6 @@ - variable: multithreaded value: "1" format: c_expression - - location: - file_name: 92-idx_priv.c - file_hash: $FILE_HASH - line: 21 - column: 3 - function: main - updates: [] - - location: - file_name: 92-idx_priv.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: main - updates: [] - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= data && data <= 1)' diff --git a/tests/regression/56-witness/65-ghost-ambiguous-lock.t b/tests/regression/56-witness/65-ghost-ambiguous-lock.t index 8115bb2921..2771ec5c50 100644 --- a/tests/regression/56-witness/65-ghost-ambiguous-lock.t +++ b/tests/regression/56-witness/65-ghost-ambiguous-lock.t @@ -22,48 +22,6 @@ value: "0" format: c_expression ghost_updates: - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 10 - column: 3 - function: t_fun - updates: [] - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 13 - column: 3 - function: t_fun - updates: [] - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 14 - column: 3 - function: t_fun - updates: [] - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 17 - column: 3 - function: t_fun - updates: [] - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 22 - column: 3 - function: fun - updates: [] - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 24 - column: 3 - function: fun - updates: [] - location: file_name: 65-ghost-ambiguous-lock.c file_hash: $FILE_HASH @@ -74,20 +32,6 @@ - variable: multithreaded value: "1" format: c_expression - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 35 - column: 3 - function: main - updates: [] - - location: - file_name: 65-ghost-ambiguous-lock.c - file_hash: $FILE_HASH - line: 37 - column: 3 - function: main - updates: [] - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= g2 && g2 <= 1)' diff --git a/tests/regression/56-witness/68-ghost-ambiguous-idx.t b/tests/regression/56-witness/68-ghost-ambiguous-idx.t index a8f2a0226a..e45399e005 100644 --- a/tests/regression/56-witness/68-ghost-ambiguous-idx.t +++ b/tests/regression/56-witness/68-ghost-ambiguous-idx.t @@ -28,20 +28,6 @@ value: "0" format: c_expression ghost_updates: - - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 8 - column: 3 - function: t_fun - updates: [] - - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 11 - column: 3 - function: t_fun - updates: [] - location: file_name: 68-ghost-ambiguous-idx.c file_hash: $FILE_HASH @@ -52,20 +38,6 @@ - variable: multithreaded value: "1" format: c_expression - - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 23 - column: 3 - function: main - updates: [] - - location: - file_name: 68-ghost-ambiguous-idx.c - file_hash: $FILE_HASH - line: 25 - column: 3 - function: main - updates: [] - entry_type: flow_insensitive_invariant flow_insensitive_invariant: string: '! multithreaded || (0 <= data && data <= 1)' From 2c25848a23e3b74859cd4b8a7be549d572a748bc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 21 Nov 2024 17:04:25 +0200 Subject: [PATCH 133/157] Remove support for old ghost_variable and ghost_update entry types --- src/analyses/mutexGhosts.ml | 48 -------------------- src/config/options.schema.json | 2 - src/witness/witnessGhost.ml | 16 +------ src/witness/yamlWitness.ml | 24 ++-------- src/witness/yamlWitnessType.ml | 67 ---------------------------- tests/util/yamlWitnessStripCommon.ml | 4 -- 6 files changed, 4 insertions(+), 157 deletions(-) diff --git a/src/analyses/mutexGhosts.ml b/src/analyses/mutexGhosts.ml index 6ed0da4d4c..3deec3ef59 100644 --- a/src/analyses/mutexGhosts.ml +++ b/src/analyses/mutexGhosts.ml @@ -122,54 +122,6 @@ struct | YamlEntryGlobal (g, task) -> let g: V.t = Obj.obj g in begin match g with - | `Left g' when YamlWitness.entry_type_enabled YamlWitnessType.GhostVariable.entry_type && YamlWitness.entry_type_enabled YamlWitnessType.GhostUpdate.entry_type -> - let (locked, unlocked, multithread) = G.node (ctx.global g) in - let g = g' in - let entries = - (* TODO: do variable_entry-s only once *) - Locked.fold (fun l acc -> - match mustlock_of_addr l with - | Some l when ghost_var_available ctx (Locked l) -> - let entry = WitnessGhost.variable_entry ~task (Locked l) in - Queries.YS.add entry acc - | _ -> - acc - ) (Locked.union locked unlocked) (Queries.YS.empty ()) - in - let entries = - Locked.fold (fun l acc -> - match mustlock_of_addr l with - | Some l when ghost_var_available ctx (Locked l) -> - let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.one in - Queries.YS.add entry acc - | _ -> - acc - ) locked entries - in - let entries = - Unlocked.fold (fun l acc -> - match mustlock_of_addr l with - | Some l when ghost_var_available ctx (Locked l) -> - let entry = WitnessGhost.update_entry ~task ~node:g (Locked l) GoblintCil.zero in - Queries.YS.add entry acc - | _ -> - acc - ) unlocked entries - in - let entries = - if not (GobConfig.get_bool "exp.earlyglobs") && multithread then ( - if ghost_var_available ctx Multithreaded then ( - let entry = WitnessGhost.variable_entry ~task Multithreaded in - let entry' = WitnessGhost.update_entry ~task ~node:g Multithreaded GoblintCil.one in - Queries.YS.add entry (Queries.YS.add entry' entries) - ) - else - entries - ) - else - entries - in - entries | `Right true when YamlWitness.entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type -> let nodes = G.update (ctx.global g) in let (variables, location_updates) = NodeSet.fold (fun node (variables, location_updates) -> diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 8534620d02..362e028ee3 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -2673,8 +2673,6 @@ "precondition_loop_invariant_certificate", "invariant_set", "violation_sequence", - "ghost_variable", - "ghost_update", "ghost_instrumentation" ] }, diff --git a/src/witness/witnessGhost.ml b/src/witness/witnessGhost.ml index 3535e8a347..3eaa8ef69b 100644 --- a/src/witness/witnessGhost.ml +++ b/src/witness/witnessGhost.ml @@ -1,7 +1,7 @@ (** Ghost variables for YAML witnesses. *) let enabled () = - (YamlWitness.entry_type_enabled YamlWitnessType.GhostVariable.entry_type && YamlWitness.entry_type_enabled YamlWitnessType.GhostUpdate.entry_type) || YamlWitness.entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type + YamlWitness.entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type module Var = WitnessGhostVar @@ -11,20 +11,6 @@ module Map = RichVarinfo.BiVarinfoMap.Make (Var) include Map -let variable_entry ~task x = - let variable = name_varinfo x in - let type_ = String.trim (CilType.Typ.show (typ x)) in (* CIL printer puts space at the end of some types *) - let initial = CilType.Exp.show (initial x) in - YamlWitness.Entry.ghost_variable ~task ~variable ~type_ ~initial - -let update_entry ~task ~node x e = - let loc = Node.location node in - let location_function = (Node.find_fundec node).svar.vname in - let location = YamlWitness.Entry.location ~location:loc ~location_function in - let variable = name_varinfo x in - let expression = CilType.Exp.show e in - YamlWitness.Entry.ghost_update ~task ~location ~variable ~expression - let variable' x = let variable = name_varinfo x in let type_ = String.trim (CilType.Typ.show (typ x)) in (* CIL printer puts space at the end of some types *) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 81072ff82d..ec9a542919 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -149,25 +149,6 @@ struct metadata = metadata (); } - let ghost_variable ~task ~variable ~type_ ~(initial): Entry.t = { - entry_type = GhostVariable { - variable; - scope = "global"; - type_; - initial; - }; - metadata = metadata ~task (); - } - - let ghost_update ~task ~location ~variable ~(expression): Entry.t = { - entry_type = GhostUpdate { - variable; - expression; - location; - }; - metadata = metadata ~task (); - } - let ghost_variable' ~variable ~type_ ~(initial): GhostInstrumentation.Variable.t = { name = variable; scope = "global"; @@ -410,9 +391,10 @@ struct entries in - (* Generate flow-insensitive entries (ghost variables and ghost updates) *) + (* Generate flow-insensitive entries (ghost instrumentation) *) let entries = - if (entry_type_enabled YamlWitnessType.GhostVariable.entry_type && entry_type_enabled YamlWitnessType.GhostUpdate.entry_type) || entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type then ( + if entry_type_enabled YamlWitnessType.GhostInstrumentation.entry_type then ( + (* TODO: only at most one ghost_instrumentation entry can ever be produced, so this fold and deduplication is overkill *) let module EntrySet = Queries.YS in fst @@ GHT.fold (fun g v accs -> match g with diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 9b5d580849..bcd8e9435f 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -644,61 +644,6 @@ struct {content} end -module GhostVariable = -struct - type t = { - variable: string; - scope: string; - type_: string; - initial: string; - } - [@@deriving eq, ord, hash] - - let entry_type = "ghost_variable" - - let to_yaml' {variable; scope; type_; initial} = - [ - ("variable", `String variable); - ("scope", `String scope); - ("type", `String type_); - ("initial", `String initial); - ] - - let of_yaml y = - let open GobYaml in - let+ variable = y |> find "variable" >>= to_string - and+ scope = y |> find "scope" >>= to_string - and+ type_ = y |> find "type" >>= to_string - and+ initial = y |> find "initial" >>= to_string in - {variable; scope; type_; initial} -end - -module GhostUpdate = -struct - type t = { - variable: string; - expression: string; - location: Location.t; - } - [@@deriving eq, ord, hash] - - let entry_type = "ghost_update" - - let to_yaml' {variable; expression; location} = - [ - ("variable", `String variable); - ("expression", `String expression); - ("location", Location.to_yaml location); - ] - - let of_yaml y = - let open GobYaml in - let+ variable = y |> find "variable" >>= to_string - and+ expression = y |> find "expression" >>= to_string - and+ location = y |> find "location" >>= Location.of_yaml in - {variable; expression; location} -end - module GhostInstrumentation = struct @@ -831,8 +776,6 @@ struct | PreconditionLoopInvariantCertificate of PreconditionLoopInvariantCertificate.t | InvariantSet of InvariantSet.t | ViolationSequence of ViolationSequence.t - | GhostVariable of GhostVariable.t - | GhostUpdate of GhostUpdate.t | GhostInstrumentation of GhostInstrumentation.t [@@deriving eq, ord, hash] @@ -845,8 +788,6 @@ struct | PreconditionLoopInvariantCertificate _ -> PreconditionLoopInvariantCertificate.entry_type | InvariantSet _ -> InvariantSet.entry_type | ViolationSequence _ -> ViolationSequence.entry_type - | GhostVariable _ -> GhostVariable.entry_type - | GhostUpdate _ -> GhostUpdate.entry_type | GhostInstrumentation _ -> GhostInstrumentation.entry_type let to_yaml' = function @@ -858,8 +799,6 @@ struct | PreconditionLoopInvariantCertificate x -> PreconditionLoopInvariantCertificate.to_yaml' x | InvariantSet x -> InvariantSet.to_yaml' x | ViolationSequence x -> ViolationSequence.to_yaml' x - | GhostVariable x -> GhostVariable.to_yaml' x - | GhostUpdate x -> GhostUpdate.to_yaml' x | GhostInstrumentation x -> GhostInstrumentation.to_yaml' x let of_yaml y = @@ -889,12 +828,6 @@ struct else if entry_type = ViolationSequence.entry_type then let+ x = y |> ViolationSequence.of_yaml in ViolationSequence x - else if entry_type = GhostVariable.entry_type then - let+ x = y |> GhostVariable.of_yaml in - GhostVariable x - else if entry_type = GhostUpdate.entry_type then - let+ x = y |> GhostUpdate.of_yaml in - GhostUpdate x else if entry_type = GhostInstrumentation.entry_type then let+ x = y |> GhostInstrumentation.of_yaml in GhostInstrumentation x diff --git a/tests/util/yamlWitnessStripCommon.ml b/tests/util/yamlWitnessStripCommon.ml index d54dd446bf..39bc231d72 100644 --- a/tests/util/yamlWitnessStripCommon.ml +++ b/tests/util/yamlWitnessStripCommon.ml @@ -74,10 +74,6 @@ struct InvariantSet {content = List.sort InvariantSet.Invariant.compare (List.map invariant_strip_file_hash x.content)} (* Sort, so order is deterministic regardless of Goblint. *) | ViolationSequence x -> ViolationSequence {content = List.map segment_strip_file_hash x.content} - | GhostVariable x -> - GhostVariable x (* no location to strip *) - | GhostUpdate x -> - GhostUpdate {x with location = location_strip_file_hash x.location} | GhostInstrumentation x -> GhostInstrumentation { (* Sort, so order is deterministic regardless of Goblint. *) ghost_variables = List.sort GhostInstrumentation.Variable.compare x.ghost_variables; From 0df4d8647afbfd2d65043c13f89047ecc3a2219b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 28 Nov 2024 13:36:28 +0200 Subject: [PATCH 134/157] Update goblint-cil to 2.0.5 in Gobview lock file --- gobview | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gobview b/gobview index 76e42c34d3..8e1b755ebc 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 76e42c34d36bd2ab6900efd661a972ba4824f065 +Subproject commit 8e1b755ebc5fb479095fb4dcc30305fe02501e47 From eb9ee513ba2cb1811750d58fd10370f31c21dda1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 28 Nov 2024 14:52:54 +0200 Subject: [PATCH 135/157] Make 29-svcomp/36-svcomp-arch multilib detection more precise Also handles missing gcc-multilib on Linux, e.g. in opam docker. There's no conf-* package for gcc-multilib. --- tests/regression/29-svcomp/dune | 2 +- tests/util/dune | 7 ++++++- tests/util/multilibConfigure.ml | 4 ++++ 3 files changed, 11 insertions(+), 2 deletions(-) create mode 100644 tests/util/multilibConfigure.ml diff --git a/tests/regression/29-svcomp/dune b/tests/regression/29-svcomp/dune index 95ac66a5ec..9b2396b313 100644 --- a/tests/regression/29-svcomp/dune +++ b/tests/regression/29-svcomp/dune @@ -17,4 +17,4 @@ (cram (applies_to 36-svcomp-arch) - (enabled_if (<> %{system} macosx))) ; https://dune.readthedocs.io/en/stable/reference/boolean-language.html + (enabled_if %{read:../../util/multilibAvailable})) ; https://dune.readthedocs.io/en/stable/reference/boolean-language.html diff --git a/tests/util/dune b/tests/util/dune index 0e32304d4f..e43d21c25d 100644 --- a/tests/util/dune +++ b/tests/util/dune @@ -1,7 +1,8 @@ (executables - (names yamlWitnessStrip yamlWitnessStripDiff) + (names yamlWitnessStrip yamlWitnessStripDiff multilibConfigure) (libraries batteries.unthreaded + goblint-cil goblint_std goblint_lib yaml @@ -9,3 +10,7 @@ goblint.build-info.dune) (flags :standard -open Goblint_std) (preprocess (pps ppx_deriving.std))) + +(rule + (target multilibAvailable) + (action (with-stdout-to %{target} (run ./multilibConfigure.exe)))) diff --git a/tests/util/multilibConfigure.ml b/tests/util/multilibConfigure.ml new file mode 100644 index 0000000000..cf59e04416 --- /dev/null +++ b/tests/util/multilibConfigure.ml @@ -0,0 +1,4 @@ +open GoblintCil + +let () = + Printf.printf "%B" (Option.is_some GoblintCil.Machdep.gcc32 && Option.is_some GoblintCil.Machdep.gcc64) From 7170d9a8944706a1adc0acaeb81a4fc6d914af7b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 28 Nov 2024 15:00:16 +0200 Subject: [PATCH 136/157] Fix unused open in multilibConfigure --- tests/util/multilibConfigure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/util/multilibConfigure.ml b/tests/util/multilibConfigure.ml index cf59e04416..96cf9a706a 100644 --- a/tests/util/multilibConfigure.ml +++ b/tests/util/multilibConfigure.ml @@ -1,4 +1,4 @@ open GoblintCil let () = - Printf.printf "%B" (Option.is_some GoblintCil.Machdep.gcc32 && Option.is_some GoblintCil.Machdep.gcc64) + Printf.printf "%B" (Option.is_some Machdep.gcc32 && Option.is_some Machdep.gcc64) From 4f83ce8369977071c5a749ad50cf5ebba7aa4f75 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 29 Nov 2024 10:51:02 +0200 Subject: [PATCH 137/157] Revert "Disable pins for v2.5.0 release" This reverts commit d066c8dd711317ae969639d45285aa5664767daa. --- goblint.opam | 8 ++++---- goblint.opam.locked | 10 ++++++++++ goblint.opam.template | 8 ++++---- 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/goblint.opam b/goblint.opam index 9f2b874ff6..9fa877d54f 100644 --- a/goblint.opam +++ b/goblint.opam @@ -96,14 +96,14 @@ dev-repo: "git+https://github.com/goblint/analyzer.git" # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") -# pin-depends: [ +pin-depends: [ # published goblint-cil 2.0.5 is currently up-to-date, so no pin needed # [ "goblint-cil.2.0.5" "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new camlidl release - # [ "camlidl.1.12" "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" ] + [ "camlidl.1.12" "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new apron release - # [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#418a217c7a70dae3f422678f3aaba38ae374d91a" ] -# ] + [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#418a217c7a70dae3f422678f3aaba38ae374d91a" ] +] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} ] diff --git a/goblint.opam.locked b/goblint.opam.locked index 3a7bb1bfa5..081731a9a3 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -137,6 +137,16 @@ conflicts: [ post-messages: [ "Do not benchmark Goblint on OCaml 5 (https://goblint.readthedocs.io/en/latest/user-guide/benchmarking/)." {ocaml:version >= "5.0.0"} ] +pin-depends: [ + [ + "camlidl.1.12" + "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" + ] + [ + "apron.v0.9.15" + "git+https://github.com/antoinemine/apron.git#418a217c7a70dae3f422678f3aaba38ae374d91a" + ] +] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} description: """\ Goblint is a sound static analysis framework for C programs using abstract interpretation. diff --git a/goblint.opam.template b/goblint.opam.template index 8766a89df2..d05a0af61d 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -1,14 +1,14 @@ # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") -# pin-depends: [ +pin-depends: [ # published goblint-cil 2.0.5 is currently up-to-date, so no pin needed # [ "goblint-cil.2.0.5" "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new camlidl release - # [ "camlidl.1.12" "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" ] + [ "camlidl.1.12" "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new apron release - # [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#418a217c7a70dae3f422678f3aaba38ae374d91a" ] -# ] + [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#418a217c7a70dae3f422678f3aaba38ae374d91a" ] +] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} ] From 77acd917865a4385c160155740d20615c0e87f2a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 29 Nov 2024 10:58:11 +0200 Subject: [PATCH 138/157] Pin released goblint-cil.2.0.5 for reproducibility --- goblint.opam | 4 ++-- goblint.opam.locked | 4 ++++ goblint.opam.template | 4 ++-- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/goblint.opam b/goblint.opam index 9fa877d54f..219c67d011 100644 --- a/goblint.opam +++ b/goblint.opam @@ -97,8 +97,8 @@ dev-repo: "git+https://github.com/goblint/analyzer.git" # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") pin-depends: [ - # published goblint-cil 2.0.5 is currently up-to-date, so no pin needed - # [ "goblint-cil.2.0.5" "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" ] + # published goblint-cil 2.0.5 is currently up-to-date, but pinned for reproducibility + [ "goblint-cil.2.0.5" "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new camlidl release [ "camlidl.1.12" "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new apron release diff --git a/goblint.opam.locked b/goblint.opam.locked index 081731a9a3..2594aea288 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -138,6 +138,10 @@ post-messages: [ "Do not benchmark Goblint on OCaml 5 (https://goblint.readthedocs.io/en/latest/user-guide/benchmarking/)." {ocaml:version >= "5.0.0"} ] pin-depends: [ + [ + "oblint-cil.2.0.5" + "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" + ] [ "camlidl.1.12" "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" diff --git a/goblint.opam.template b/goblint.opam.template index d05a0af61d..84dcc24d8d 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -2,8 +2,8 @@ # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") pin-depends: [ - # published goblint-cil 2.0.5 is currently up-to-date, so no pin needed - # [ "goblint-cil.2.0.5" "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" ] + # published goblint-cil 2.0.5 is currently up-to-date, but pinned for reproducibility + [ "goblint-cil.2.0.5" "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new camlidl release [ "camlidl.1.12" "git+https://github.com/xavierleroy/camlidl.git#1c1e87e3f56c2c6b3226dd0af3510ef414b462d0" ] # pinned for stability (https://github.com/goblint/analyzer/issues/1520), remove after new apron release From dbdefab9825123e08c92b4c36618e7eacb7883d4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 29 Nov 2024 11:21:22 +0200 Subject: [PATCH 139/157] Fix must-double-locking in regression tests --- tests/regression/04-mutex/32-allfuns.c | 4 ++-- tests/regression/09-regions/31-equ_rc.c | 2 +- tests/regression/09-regions/32-equ_nr.c | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/regression/04-mutex/32-allfuns.c b/tests/regression/04-mutex/32-allfuns.c index b59c487c53..e6b88e47ce 100644 --- a/tests/regression/04-mutex/32-allfuns.c +++ b/tests/regression/04-mutex/32-allfuns.c @@ -8,11 +8,11 @@ pthread_mutex_t B_mutex = PTHREAD_MUTEX_INITIALIZER; void t1() { pthread_mutex_lock(&A_mutex); myglobal++; //RACE! - pthread_mutex_lock(&A_mutex); + pthread_mutex_unlock(&A_mutex); } void t2() { pthread_mutex_lock(&B_mutex); myglobal++; //RACE! - pthread_mutex_lock(&B_mutex); + pthread_mutex_unlock(&B_mutex); } diff --git a/tests/regression/09-regions/31-equ_rc.c b/tests/regression/09-regions/31-equ_rc.c index 7cea370c58..2f3aff7f63 100644 --- a/tests/regression/09-regions/31-equ_rc.c +++ b/tests/regression/09-regions/31-equ_rc.c @@ -15,7 +15,7 @@ struct s { void *t_fun(void *arg) { pthread_mutex_lock(&A.mutex); B.datum = 5; // RACE! - pthread_mutex_lock(&A.mutex); + pthread_mutex_unlock(&A.mutex); return NULL; } diff --git a/tests/regression/09-regions/32-equ_nr.c b/tests/regression/09-regions/32-equ_nr.c index d9b909546e..a242448ba8 100644 --- a/tests/regression/09-regions/32-equ_nr.c +++ b/tests/regression/09-regions/32-equ_nr.c @@ -15,7 +15,7 @@ struct s { void *t_fun(void *arg) { pthread_mutex_lock(&A.mutex); A.datum = 5; // NORACE - pthread_mutex_lock(&A.mutex); + pthread_mutex_unlock(&A.mutex); return NULL; } From 218770b8f3f825338db1e10911668151d3317f14 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 29 Nov 2024 11:21:55 +0200 Subject: [PATCH 140/157] Check must-double-locking in 03-practical/21-pfscan_combine_minimal --- tests/regression/03-practical/21-pfscan_combine_minimal.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/03-practical/21-pfscan_combine_minimal.c b/tests/regression/03-practical/21-pfscan_combine_minimal.c index abdef0627b..86cfdabac1 100644 --- a/tests/regression/03-practical/21-pfscan_combine_minimal.c +++ b/tests/regression/03-practical/21-pfscan_combine_minimal.c @@ -18,7 +18,7 @@ int pqueue_init(PQUEUE *qp) void pqueue_close(PQUEUE *qp ) { - pthread_mutex_lock(& qp->mtx); + pthread_mutex_lock(& qp->mtx); // WARN (must double locking) qp->closed = 1; pthread_mutex_unlock(& qp->mtx); return; @@ -26,7 +26,7 @@ void pqueue_close(PQUEUE *qp ) int pqueue_put(PQUEUE *qp) { - pthread_mutex_lock(& qp->mtx); + pthread_mutex_lock(& qp->mtx); // WARN (must double locking) if (qp->closed) { // pfscan actually has a bug and is missing the following unlock at early return // pthread_mutex_unlock(& qp->mtx); From 68cd95237ebbb2023f6c9f7e59dc5f2d33d8ad45 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 29 Nov 2024 11:30:41 +0200 Subject: [PATCH 141/157] Fix goblint-cil typo in opam lock file --- goblint.opam.locked | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/goblint.opam.locked b/goblint.opam.locked index 2594aea288..e5176b9007 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -139,7 +139,7 @@ post-messages: [ ] pin-depends: [ [ - "oblint-cil.2.0.5" + "goblint-cil.2.0.5" "git+https://github.com/goblint/cil.git#c79208b21ea61d7b72eae29a18c1ddeda4795dfd" ] [ From ffe255b9a60a1c4919b565f6c9a0e07c47ac7218 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 29 Nov 2024 14:11:46 +0200 Subject: [PATCH 142/157] Count witness.invariant.flow_insensitive-as location invariants in summary --- src/witness/yamlWitness.ml | 2 ++ tests/regression/13-privatized/04-priv_multi.t | 2 +- tests/regression/13-privatized/74-mutex.t | 4 ++-- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index e3978f9929..9d04b597fa 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -385,6 +385,7 @@ struct fold_flow_insensitive_as_location ~inv (fun ~location ~inv acc -> let invariant = Entry.invariant (CilType.Exp.show inv) in let entry = Entry.location_invariant ~task ~location ~invariant in + incr cnt_location_invariant; entry :: acc ) acc | `Lifted _, _ @@ -605,6 +606,7 @@ struct fold_flow_insensitive_as_location ~inv (fun ~location ~inv acc -> let invariant = CilType.Exp.show inv in let invariant = Entry.location_invariant' ~location ~invariant in + incr cnt_location_invariant; invariant :: acc ) acc | `Bot | `Top -> (* global bot might only be possible for alloc variables, if at all, so emit nothing *) diff --git a/tests/regression/13-privatized/04-priv_multi.t b/tests/regression/13-privatized/04-priv_multi.t index af7c9b2098..1f6dff3fdc 100644 --- a/tests/regression/13-privatized/04-priv_multi.t +++ b/tests/regression/13-privatized/04-priv_multi.t @@ -215,7 +215,7 @@ Flow-insensitive invariants as location invariants. [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (04-priv_multi.c:45:10-45:11) [Warning][Deadcode][CWE-571] condition 'B > 0' is always true (04-priv_multi.c:47:9-47:14) [Info][Witness] witness generation summary: - location invariants: 0 + location invariants: 9 loop invariants: 0 flow-insensitive invariants: 0 total generation entries: 10 diff --git a/tests/regression/13-privatized/74-mutex.t b/tests/regression/13-privatized/74-mutex.t index 1d750a211c..4b370db387 100644 --- a/tests/regression/13-privatized/74-mutex.t +++ b/tests/regression/13-privatized/74-mutex.t @@ -108,7 +108,7 @@ Flow-insensitive invariants as location invariants. total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: - location invariants: 0 + location invariants: 2 loop invariants: 0 flow-insensitive invariants: 0 total generation entries: 3 @@ -177,7 +177,7 @@ Same with ghost_instrumentation and invariant_set entries. total lines: 15 [Warning][Deadcode][CWE-571] condition '1' (possibly inserted by CIL) is always true (74-mutex.c:19:10-19:11) [Info][Witness] witness generation summary: - location invariants: 0 + location invariants: 2 loop invariants: 0 flow-insensitive invariants: 0 total generation entries: 2 From f3dfca7a9ab28fe16ce77bfeac0d55f65058ff4c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 29 Nov 2024 17:25:15 +0200 Subject: [PATCH 143/157] Change must-double-locking in 03-practical/21-pfscan_combine_minimal to TODO On MacOS the mutex type is top because it's zero-initialized global. On MacOS zero-initialized mutex isn't the same as a default mutex (type 0). --- tests/regression/03-practical/21-pfscan_combine_minimal.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/03-practical/21-pfscan_combine_minimal.c b/tests/regression/03-practical/21-pfscan_combine_minimal.c index 86cfdabac1..b8fc7948b2 100644 --- a/tests/regression/03-practical/21-pfscan_combine_minimal.c +++ b/tests/regression/03-practical/21-pfscan_combine_minimal.c @@ -18,7 +18,7 @@ int pqueue_init(PQUEUE *qp) void pqueue_close(PQUEUE *qp ) { - pthread_mutex_lock(& qp->mtx); // WARN (must double locking) + pthread_mutex_lock(& qp->mtx); // TODO (OSX): WARN (must double locking) qp->closed = 1; pthread_mutex_unlock(& qp->mtx); return; @@ -26,7 +26,7 @@ void pqueue_close(PQUEUE *qp ) int pqueue_put(PQUEUE *qp) { - pthread_mutex_lock(& qp->mtx); // WARN (must double locking) + pthread_mutex_lock(& qp->mtx); // TODO (OSX): WARN (must double locking) if (qp->closed) { // pfscan actually has a bug and is missing the following unlock at early return // pthread_mutex_unlock(& qp->mtx); From 0706c136b7897191ea1241d76f7c3dc716d939a1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:14:35 +0200 Subject: [PATCH 144/157] Copy VMCAI 2025 artifact description from concurrency-witnesses repo --- docs/artifact-descriptions/vmcai25.md | 288 ++++++++++++++++++++++++++ mkdocs.yml | 1 + 2 files changed, 289 insertions(+) create mode 100644 docs/artifact-descriptions/vmcai25.md diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md new file mode 100644 index 0000000000..08b2c468b8 --- /dev/null +++ b/docs/artifact-descriptions/vmcai25.md @@ -0,0 +1,288 @@ +# Artifact for VMCAI'2025 Paper "Correctness Witnesses for Concurrent Programs: Bridging the Semantic Divide with Ghosts" + +------------------------------------------------------------------------------- + +## OVERVIEW + +This artifact contains the following components: + + EVALUATION RESULTS :: The evaluation results, and overview tables (HTML) + generated from the raw data. + SOURCE CODE :: Source code for Goblint and Ultimate GemCutter, + the verification tools used in the experiments + for the paper. + VERIFIER BINARIES :: Binaries for Goblint and Ultimate GemCutter. + BENCHMARK PROGRAMS :: Benchmarks used for evaluation of the verifiers. + BENCHMARK WITNESSES :: The witnesses generated by Goblint, as used in the + experiments. + BENCHEXEC TOOL :: The BenchExec benchmarking tool can be used + to replicate our results on these benchmarks. + +The next section gives instructions on how to setup and quickly get an overview of the artifact. +The subsequent sections then describe each of these components in detail. +The final section gives information on how to reuse this artifact. + +------------------------------------------------------------------------------- + +## GETTING STARTED + +### 1. Setup + +The artifact is a virtual machine (VM). Follow these steps to set it up: + +* If you have not done so already, install VirtualBox. + (https://www.virtualbox.org/wiki/Downloads) +* Download the artifact. +* Import the artifact via the VirtualBox UI (`File > Import Appliance`) + or by running `VBoxManage import ghost-witnesses.ova`. + +You can then start the VM from the VirtualBox UI. +Login with user `vagrant` and password `vagrant`. +(Note: By default, the user `Ubuntu` may be selected on the login screen. Click on the name and switch to user `vagrant`.) + +You may want to install VirtualBox guest additions (). +If the usual installation does not work, try the following steps: + +* Add a disk drive to the VM in its settings (the VM must be off for this). +* After starting the VM and logging in, select `Devices > Insert Guest Additions CD image` from the VirtualBox menu. +* Run the following in a terminal: + `sudo mount /dev/cdrom /mnt && cd /mnt && sudo ./VBoxLinuxAdditions.run` + +### 2. Inspect the evaluation results + +To extract the table data used in the paper from our raw evaluation results, open a terminal in the VM (`Ctrl+Alt+T`) and run the following commands: + + ~/scripts/analyse-witnesses.py "$HOME/witness-generation/paper-evaluation/goblint.2024-09-02_08-21-23.files" + cd ~/witness-validation/paper-evaluation/ + WITNESS_DIR="$HOME/witness-generation/paper-evaluation/goblint.2024-09-02_08-21-23.files" ~/scripts/analyse-validation.py + +The times for the Table 2 are given first in seconds and then pretty-printed as in the paper. + +For a more detailed inspection and visualization of the data, take a look at the generated HTML report. +Just open the file `~/witness-validation/paper-evaluation/results.2024-09-24_22-00-48.table.html` in firefox. +For detailed information, see the "EVALUATION RESULTS" section below. + +### 3. Quick Test of the Benchmark Setup + +To analyse some programs with Goblint and analyse the generated witnesses with GemCutter, run + + ~/scripts/quick-run.sh + +on a console in the VM. +This will analyse a single program with Goblint and generate witnesses using the four analyses described in the paper. +Subsequently, the script will run GemCutter's verification, witness confirmation and witness validation analyses on the example. + +The whole run should should conclude successfully for all configurations in about 2min. +This is indicated by the benchmark results `true` printed on the console, and the fact that the final output looks roughly like this: + + Table 1: Witness Confirmation + ============================= + correct programs + ----------------------------- + protection-ghost : total= 1 , confirmed= 1 , rejected= 0 , confirmation rate= 100.0 % , resource out= 0 + mutex-meet-ghost : total= 1 , confirmed= 1 , rejected= 0 , confirmation rate= 100.0 % , resource out= 0 + protection-local : total= 1 , confirmed= 1 , rejected= 0 , confirmation rate= 100.0 % , resource out= 0 + mutex-meet-local : total= 1 , confirmed= 1 , rejected= 0 , confirmation rate= 100.0 % , resource out= 0 + + confirmation range: 100.0 % - 100.0 % + + incorrect programs + ----------------------------- + No programs with witnesses found for protection-ghost. Skipping benchmark set... + No programs with witnesses found for mutex-meet-ghost. Skipping benchmark set... + No programs with witnesses found for protection-local. Skipping benchmark set... + No programs with witnesses found for mutex-meet-local. Skipping benchmark set... + + confirmation range: 100.0 % - 0.0 % + + + Table 2: Witness Validation + =========================== + protection-ghost + ---------------- + validation : {'number': 1, 'time': 14, 'time_pretty': 0:00:14} + verification : {'number': 1, 'time': 12, 'time_pretty': 0:00:12} + 0 tasks could be validated but not verified + + mutex-meet-ghost + ---------------- + validation : {'number': 1, 'time': 13, 'time_pretty': 0:00:13} + verification : {'number': 1, 'time': 12, 'time_pretty': 0:00:12} + 0 tasks could be validated but not verified + + protection-local + ---------------- + validation : {'number': 1, 'time': 12, 'time_pretty': 0:00:12} + verification : {'number': 1, 'time': 12, 'time_pretty': 0:00:12} + 0 tasks could be validated but not verified + + mutex-meet-local + ---------------- + validation : {'number': 1, 'time': 13, 'time_pretty': 0:00:13} + verification : {'number': 1, 'time': 12, 'time_pretty': 0:00:12} + 0 tasks could be validated but not verified + + ~ + + =============================================================================== + Completed quick benchmark test run. + + Results of witness generation can be found in: /home/vagrant/witness-generation/2024-10-01_08-57-09 + Generated witnesses are located in: /home/vagrant/witness-generation/2024-10-01_08-57-09/goblint.2024-10-01_08-57-09.files + Results of witness validation can be found in: /home/vagrant/witness-validation/2024-10-01_08-57-09 + =============================================================================== + +For a slightly larger set of experiments, run + + ~/scripts/medium-run.sh + +This will run an entire folder of SV-COMP benchmarks through Goblint and subsequently analyse the generated witness with GemCutter. +The whole run should complete in 3-4h. +(Note: This run uses a smaller timeout and memory limit than the full evaluation used in the paper, so the results for individual benchmarks may differ.) + +#### Troubleshooting +On certain old host machines, GemCutter fails with `ERROR(7)`, and the log files (`/home/vagrant/witness-validation/YYYY-MM-DD_hh-mm-ss/concurrency-witness-validation-gemcutter.YYYY-MM-DD_hh-mm-ss.logfiles/*.log`) contain a message as follows: + + [2024-10-01 22:04:14,025 INFO L327 MonitoredProcess]: [MP /home/vagrant/ultimate/releaseScripts/default/UGemCutter-linux/z3 SMTLIB2_COMPLIANT=true -memory:2024 -smt2 -in -t:2000 (1)] Waiting until timeout for monitored process + [2024-10-01 22:04:14,058 FATAL L? ?]: An unrecoverable error occured during an interaction with an SMT solver: + de.uni_freiburg.informatik.ultimate.logic.SMTLIBException: External (MP /home/vagrant/ultimate/releaseScripts/default/UGemCutter-linux/z3 SMTLIB2_COMPLIANT=true -memory:2024 -smt2 -in -t:2000 (1) with exit command (exit)) Received EOF on stdin. No stderr output. + +This is because the version of Z3 shipped with GemCutter uses certain processor instructions that the host does not support or VirtualBox emulates incorrectly. +In this case, download an official build of Z3 () and replace the file `~/ultimate/releaseScripts/default/UGemCutter-linux/z3` with the corresponding binary from the official ZIP: + + wget https://github.com/Z3Prover/z3/releases/download/z3-4.12.5/z3-4.12.5-x64-glibc-2.31.zip + unzip z3-4.12.5-x64-glibc-2.31.zip + cp z3-4.12.5-x64-glibc-2.31/bin/z3 ~/ultimate/releaseScripts/default/UGemCutter-linux/z3 + +### 4. Running the Full Experiments + +To re-run the full experiments, execute + + ~/scripts/full-run.sh + +This script behaves similarly to the smaller variants in the previous sections. +Note however: + +- By default the experiments require 16 GB of memory per benchmark (this configuration was used for the experiments in the paper). + To reproduce this, you will have to modify the VM's settings in VirtualBox and increase the available memory (shutdown the machine while doing so). + + Alternatively, you can run the experiments with a reduced memory limit. + To do so, modify the environment variable `BENCHMARK_PARAMS`. + For instance, the following allows only 4GB of memory per benchmark: + + BENCHMARK_PARAMS="-M 4GB" ~/scripts/full-run.sh + +- The full evaluation for the paper required around 3 days. + In this evaluation, we used the benchexec tool to run 14 validation tasks in parallel (occupying up to 28 cores at a time). + + By default, the provided script only runs one benchmark at a time. + If you have sufficient cores and memory available (adjust the VM settings accordingly), you can run multiple benchmarks in parallel by setting the environment variable `BENCHEXEC_THREADS`. You may also execute the experiments with a reduced timeout. + For instance, the following command runs 4 benchmarks in parallel at a time (occupying up to 8 cores), and gives each benchmark a 300s timeout and 4GB memory limit: + + BENCHEXEC_THREADS=4 BENCHMARK_PARAMS="-T 300s -M 4GB" ~/scripts/full-run.sh + +Naturally, changes to the timeout or memory are expected to affect the evaluation numbers. + +---------------------------------------------------------------------------------- + +## EVALUATION RESULTS + +The evaluation results that form the basis for the experimental data in the paper can be found in the directory `~/witness-validation/paper-evaluation/`. +The witnesses generated by Goblint that formed the basis for this evaluation can be found in `~/witness-generation/paper-evaluation/`. +See below for detailed info to reproduce the tables and figures of the paper. + +The file `~/witness-validation/paper-evaluation/~/witness-validation/paper-evaluation/` contains an HTML overview page generated by the BenchExec benchmarking tool, which displays individual results, quantile and scatter plots. Through the filtering sidebar (top right corner), detailed analyses can be made. + +The table contains the following configurations : + +* `verify` -- GemCutter verification, without any witness +* `verify+validate-goblint-witnesses-{mutex-meet,protection}-{ghost,local}` -- GemCutter witness validation, applied to the 4 different witness sets generated by Goblint. + In this mode, GemCutter checks if the given witness is valid and the corresponding program is correct. +* `validate-goblint-witnesses-{mutex-meet,protection}-{ghost,local}` -- GemCutter witness _confirmation_, applied to the different witness sets. + In this mode, described in the paper, GemCutter only checks if the given witness' invariants are correct, but does not prove the corresponding program correct. + +The summary table shows how many benchmarks were analysed and the results. +- The row `correct true` indicates tasks that were successfully verified (for `verify`), or where the witness was confirmed resp. validated (for the other configurations). +- The row `correct false` indicates that a bug was found (for `verify`), resp. that witness validation failed and a witness was rejected. + The latter only happens for programs that are incorrect, hence there can be no valid correctness witness and rejection is expected. + As witness validation is not possible for incorrect programs, this data is not discussed in the paper and only appears here due to the benchmark setup. +- The row `incorrect false` would indicate that GemCutter finds a supposed bug in a correct program (for `verify`). + For witness confirmation configurations, it indicates that GemCutter confirmed the correctness witness given by Goblint, for an incorrect program. + As witness confirmation ignores the program's correctness, these results are expected and do not indicate a problem in one of the tools. + +The *Table* tab gives access to detailed evaluation results for each file. +Clicking on a status shows the complete GemCutter log for the benchmark run. + +> **Note:** If you are trying to view logs for individual runs through the HTML table (by clicking on the evaluation result `true` or `false`), you may encounter a warning because browsers block access to local files. Follow the instructions in the message to enable log viewing. + +As described above (in section _2. Inspect the evaluation results_), the artifact provides python scripts to directly extract the data shown in the paper from the benchmark results. + + +---------------------------------------------------------------------------------- + +## SOURCE CODE + +### GemCutter + +Ultimate GemCutter is developed as part of the Ultimate program analysis framework () and is implemented in Java. The source code for Ultimate at the time of evaluation can be found in this artifact in the `~/ultimate` directory. + +The directory `trunk/source/CACSL2BoogieTranslator/src/de/uni_freiburg/informatik/ultimate/plugins/generator/cacsl2boogietranslator/witness` is of particular interest for the present paper. +The code in this directory handles instrumentation of the program with various witness entries, as part of Ultimate's translation of the original C code to the intermediate verification language Boogie. + +More recent versions of Ultimate can be found at . + +### Goblint + +The Goblint analyzer () is developed by TU Munich and University of Tartu. The source code for Goblint at the time of evaluation can be found in this artifact in the `~/goblint` directory. + +More recent versions of Goblint can be found at . + +---------------------------------------------------------------------------------- + +## VERIFIER BINARIES + +A pre-built binary of GemCutter can be found in `~/ultimate/releaseScripts/default/UGemCutter-linux/`. +For information on how to execute GemCutter, consult the `README` in `~/ultimate/releaseScripts/default/UGemCutter-linux/`. +To build Ultimate GemCutter from scratch, go to `~/ultimate/releaseScripts/default/` and run `./makeFresh.sh`. + +A pre-built binary of Goblint is available as `~/goblint/goblint`. +See `~/goblint/README.md` for information on how to run Goblint. +To build Goblint from scratch, run `make setup && make release`. + +Both GemCutter and Goblint can be invoked via the BenchExec benchmarking tool () which is installed in the VM. +For examples, see the benchmark definition files `~/witness-generation/goblint.xml` resp. `~/witness-validation/gemcutter.xml` and the scripts `~/scripts/generate-witnesses.sh` resp. `~/scripts/validate-witnesses.sh`. + +---------------------------------------------------------------------------------- + +## BENCHMARK PROGRAMS + +This artifact includes the benchmark programs on which we evaluated the verifiers. +These benchmarks are taken from the publicly available sv-benchmarks set () +and correspond to the _ConcurrencySafety-Main_ category of SV-COMP'24 (). +The benchmarks are written in C and use POSIX threads (`pthreads`) to model concurrency. + +---------------------------------------------------------------------------------- + +## EXTENDING & REUSING THIS ARTIFACT + +* **Building a modified version of the VM:** This VM was created using the `vagrant` tool (). + The `Vagrantfile` used to build the artifact, along with several other files used in the build, is included in the directory `~/artifact`. + This can be used to inspect the setup of the VM, and even build a modified version. + + Note that, to rebuild the VM, some files (e.g. scripts, evaluation results, this README) need to be extracted from the image and placed in a suitable location on your machine. + +* **Adding benchmarks:** You can easily add your own benchmarks programs written in C. + C programs should contain an empty function called `reach_error()`. Goblint and GemCutter then check that this function is never invoked. Certain (gcc) preprocessing steps may be necessary, e.g. to resolve `#include`s. See the SV-COMP benchmarks for examples (the preprocessed files typically have the extension `.i`). + + To run the evaluation on your own programs, you must edit the benchmark definition files `~/witness-generation/goblint.xml.template` resp. `~/witness-validation/gemcutter.xml.template`. + Replace the `` path specified in the task set `minimal` with your own path. + You can then simply run `~/scripts/quick-run.sh`. + +* **Adding more tools:** As described above, you can reuse the `Vagrantfile` for this artifact and extend it with whatever installation measures are necessary for an additional tool. Also note, that in order to run other tools with BenchExec, you must write a *tool info module* in python (). + + Create a new benchmark definition file for your tool (). + The existing files `~/witness-generation/goblint.xml.template` resp. `~/witness-validation/gemcutter.xml.template` can serve as an example. + + If you are planning to support generation or validation of correctness witnesses using the proposed format, take a look at the YAML schema definition for the format linked in the paper. + The schema is also available in this artifact as `~/artifact-files/correctness-witness-schema.yml`. + diff --git a/mkdocs.yml b/mkdocs.yml index a4c4238601..b55787f8da 100644 --- a/mkdocs.yml +++ b/mkdocs.yml @@ -41,3 +41,4 @@ nav: - "🇸 SAS '21": artifact-descriptions/sas21.md - "🇪 ESOP '23": artifact-descriptions/esop23.md - "🇻 VMCAI '24": artifact-descriptions/vmcai24.md + - "🇻 VMCAI '25": artifact-descriptions/vmcai25.md From fa3538c576e39166d0d0850772d83273afc95f48 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:21:03 +0200 Subject: [PATCH 145/157] Fix lists in VMACI25 artifact description --- docs/artifact-descriptions/vmcai25.md | 43 ++++++++++++++------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md index 08b2c468b8..75374c659b 100644 --- a/docs/artifact-descriptions/vmcai25.md +++ b/docs/artifact-descriptions/vmcai25.md @@ -164,22 +164,22 @@ This script behaves similarly to the smaller variants in the previous sections. Note however: - By default the experiments require 16 GB of memory per benchmark (this configuration was used for the experiments in the paper). - To reproduce this, you will have to modify the VM's settings in VirtualBox and increase the available memory (shutdown the machine while doing so). + To reproduce this, you will have to modify the VM's settings in VirtualBox and increase the available memory (shutdown the machine while doing so). - Alternatively, you can run the experiments with a reduced memory limit. - To do so, modify the environment variable `BENCHMARK_PARAMS`. - For instance, the following allows only 4GB of memory per benchmark: + Alternatively, you can run the experiments with a reduced memory limit. + To do so, modify the environment variable `BENCHMARK_PARAMS`. + For instance, the following allows only 4GB of memory per benchmark: - BENCHMARK_PARAMS="-M 4GB" ~/scripts/full-run.sh + BENCHMARK_PARAMS="-M 4GB" ~/scripts/full-run.sh - The full evaluation for the paper required around 3 days. - In this evaluation, we used the benchexec tool to run 14 validation tasks in parallel (occupying up to 28 cores at a time). + In this evaluation, we used the benchexec tool to run 14 validation tasks in parallel (occupying up to 28 cores at a time). - By default, the provided script only runs one benchmark at a time. - If you have sufficient cores and memory available (adjust the VM settings accordingly), you can run multiple benchmarks in parallel by setting the environment variable `BENCHEXEC_THREADS`. You may also execute the experiments with a reduced timeout. - For instance, the following command runs 4 benchmarks in parallel at a time (occupying up to 8 cores), and gives each benchmark a 300s timeout and 4GB memory limit: + By default, the provided script only runs one benchmark at a time. + If you have sufficient cores and memory available (adjust the VM settings accordingly), you can run multiple benchmarks in parallel by setting the environment variable `BENCHEXEC_THREADS`. You may also execute the experiments with a reduced timeout. + For instance, the following command runs 4 benchmarks in parallel at a time (occupying up to 8 cores), and gives each benchmark a 300s timeout and 4GB memory limit: - BENCHEXEC_THREADS=4 BENCHMARK_PARAMS="-T 300s -M 4GB" ~/scripts/full-run.sh + BENCHEXEC_THREADS=4 BENCHMARK_PARAMS="-T 300s -M 4GB" ~/scripts/full-run.sh Naturally, changes to the timeout or memory are expected to affect the evaluation numbers. @@ -202,6 +202,7 @@ The table contains the following configurations : In this mode, described in the paper, GemCutter only checks if the given witness' invariants are correct, but does not prove the corresponding program correct. The summary table shows how many benchmarks were analysed and the results. + - The row `correct true` indicates tasks that were successfully verified (for `verify`), or where the witness was confirmed resp. validated (for the other configurations). - The row `correct false` indicates that a bug was found (for `verify`), resp. that witness validation failed and a witness was rejected. The latter only happens for programs that are incorrect, hence there can be no valid correctness witness and rejection is expected. @@ -266,23 +267,23 @@ The benchmarks are written in C and use POSIX threads (`pthreads`) to model conc ## EXTENDING & REUSING THIS ARTIFACT * **Building a modified version of the VM:** This VM was created using the `vagrant` tool (). - The `Vagrantfile` used to build the artifact, along with several other files used in the build, is included in the directory `~/artifact`. - This can be used to inspect the setup of the VM, and even build a modified version. + The `Vagrantfile` used to build the artifact, along with several other files used in the build, is included in the directory `~/artifact`. + This can be used to inspect the setup of the VM, and even build a modified version. - Note that, to rebuild the VM, some files (e.g. scripts, evaluation results, this README) need to be extracted from the image and placed in a suitable location on your machine. + Note that, to rebuild the VM, some files (e.g. scripts, evaluation results, this README) need to be extracted from the image and placed in a suitable location on your machine. * **Adding benchmarks:** You can easily add your own benchmarks programs written in C. - C programs should contain an empty function called `reach_error()`. Goblint and GemCutter then check that this function is never invoked. Certain (gcc) preprocessing steps may be necessary, e.g. to resolve `#include`s. See the SV-COMP benchmarks for examples (the preprocessed files typically have the extension `.i`). + C programs should contain an empty function called `reach_error()`. Goblint and GemCutter then check that this function is never invoked. Certain (gcc) preprocessing steps may be necessary, e.g. to resolve `#include`s. See the SV-COMP benchmarks for examples (the preprocessed files typically have the extension `.i`). - To run the evaluation on your own programs, you must edit the benchmark definition files `~/witness-generation/goblint.xml.template` resp. `~/witness-validation/gemcutter.xml.template`. - Replace the `` path specified in the task set `minimal` with your own path. - You can then simply run `~/scripts/quick-run.sh`. + To run the evaluation on your own programs, you must edit the benchmark definition files `~/witness-generation/goblint.xml.template` resp. `~/witness-validation/gemcutter.xml.template`. + Replace the `` path specified in the task set `minimal` with your own path. + You can then simply run `~/scripts/quick-run.sh`. * **Adding more tools:** As described above, you can reuse the `Vagrantfile` for this artifact and extend it with whatever installation measures are necessary for an additional tool. Also note, that in order to run other tools with BenchExec, you must write a *tool info module* in python (). - Create a new benchmark definition file for your tool (). - The existing files `~/witness-generation/goblint.xml.template` resp. `~/witness-validation/gemcutter.xml.template` can serve as an example. + Create a new benchmark definition file for your tool (). + The existing files `~/witness-generation/goblint.xml.template` resp. `~/witness-validation/gemcutter.xml.template` can serve as an example. - If you are planning to support generation or validation of correctness witnesses using the proposed format, take a look at the YAML schema definition for the format linked in the paper. - The schema is also available in this artifact as `~/artifact-files/correctness-witness-schema.yml`. + If you are planning to support generation or validation of correctness witnesses using the proposed format, take a look at the YAML schema definition for the format linked in the paper. + The schema is also available in this artifact as `~/artifact-files/correctness-witness-schema.yml`. From 9fecf6ee40761503ee63b1072db0937e23dbdc69 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:23:28 +0200 Subject: [PATCH 146/157] Add Goblint code references to VMCAI25 artifact description --- docs/artifact-descriptions/vmcai25.md | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md index 75374c659b..b4eec295ac 100644 --- a/docs/artifact-descriptions/vmcai25.md +++ b/docs/artifact-descriptions/vmcai25.md @@ -236,6 +236,16 @@ More recent versions of Ultimate can be found at ) is developed by TU Munich and University of Tartu. The source code for Goblint at the time of evaluation can be found in this artifact in the `~/goblint` directory. +The code for this paper is the following: + +1. `src/witness/witnessGhostVar.ml` and `src/witness/witnessGhost.ml` define the data types for ghost variables. +2. `src/analyses/mutexGhosts.ml` defines the analysis which determines the ghost variables for a specific program and their updates. +3. `src/analyses/basePriv.ml` lines 342-365 define the invariants with mutex ghost variables from non-relational _mutex-meet_ analysis. +4. `src/analyses/apron/relationPriv.apron.ml` lines 717-750 define the invariants with mutex ghost variables from relational _mutex-meet_ analysis. +5. `src/analyses/base.ml` lines 1269-1289 and `src/analyses/apron/relationAnalysis.apron.ml` lines 637-644 define the wrapping of the invariants with multithreaded mode ghost variables. +6. `src/analyses/basePriv.ml` lines 882-909 define the invariants with mutex ghost variables from (non-relational) _protection_ analysis. +7. `src/witness/yamlWitness.ml` lines 398-421 and 589-621 define the YAML output of ghost variables, their updates and the invariants. + More recent versions of Goblint can be found at . ---------------------------------------------------------------------------------- From 5c9b5fb5e67572f5b8dd4a0424558d469b7bcf2f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:28:46 +0200 Subject: [PATCH 147/157] Rewrite VMCAI25 artifact description intro --- docs/artifact-descriptions/vmcai25.md | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md index b4eec295ac..ac9312caa8 100644 --- a/docs/artifact-descriptions/vmcai25.md +++ b/docs/artifact-descriptions/vmcai25.md @@ -1,4 +1,11 @@ -# Artifact for VMCAI'2025 Paper "Correctness Witnesses for Concurrent Programs: Bridging the Semantic Divide with Ghosts" +# VMCAI '25 Artifact Description +## Correctness Witnesses for Concurrent Programs: Bridging the Semantic Divide with Ghosts + +This is the artifact description for our [VMCAI '25 paper "Correctness Witnesses for Concurrent Programs: Bridging the Semantic Divide with Ghosts"](https://doi.org/10.48550/arXiv.2411.16612). +The artifact is available on [Zenodo](https://doi.org/10.5281/zenodo.13863579). + +**The description here is provided for convenience and not maintained.** +The artifact contains [Goblint at `vmcai25` git tag](https://github.com/goblint/analyzer/releases/tag/vmcai25). ------------------------------------------------------------------------------- From 55bfe9631ab58fdf0275b8560eb222eba0e2f361 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:31:55 +0200 Subject: [PATCH 148/157] Remove all-caps headings in VMCAI25 artifact description --- docs/artifact-descriptions/vmcai25.md | 28 +++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md index ac9312caa8..9f2de1c511 100644 --- a/docs/artifact-descriptions/vmcai25.md +++ b/docs/artifact-descriptions/vmcai25.md @@ -9,20 +9,20 @@ The artifact contains [Goblint at `vmcai25` git tag](https://github.com/goblint/ ------------------------------------------------------------------------------- -## OVERVIEW +## Overview This artifact contains the following components: - EVALUATION RESULTS :: The evaluation results, and overview tables (HTML) + Evaluation Results :: The evaluation results, and overview tables (HTML) generated from the raw data. - SOURCE CODE :: Source code for Goblint and Ultimate GemCutter, + Source Code :: Source code for Goblint and Ultimate GemCutter, the verification tools used in the experiments for the paper. - VERIFIER BINARIES :: Binaries for Goblint and Ultimate GemCutter. - BENCHMARK PROGRAMS :: Benchmarks used for evaluation of the verifiers. - BENCHMARK WITNESSES :: The witnesses generated by Goblint, as used in the + Verifier Binaries :: Binaries for Goblint and Ultimate GemCutter. + Benchmark Programs :: Benchmarks used for evaluation of the verifiers. + Benchmark Witnesses :: The witnesses generated by Goblint, as used in the experiments. - BENCHEXEC TOOL :: The BenchExec benchmarking tool can be used + BenchExec Tool :: The BenchExec benchmarking tool can be used to replicate our results on these benchmarks. The next section gives instructions on how to setup and quickly get an overview of the artifact. @@ -31,7 +31,7 @@ The final section gives information on how to reuse this artifact. ------------------------------------------------------------------------------- -## GETTING STARTED +## Getting Started ### 1. Setup @@ -67,7 +67,7 @@ The times for the Table 2 are given first in seconds and then pretty-printed as For a more detailed inspection and visualization of the data, take a look at the generated HTML report. Just open the file `~/witness-validation/paper-evaluation/results.2024-09-24_22-00-48.table.html` in firefox. -For detailed information, see the "EVALUATION RESULTS" section below. +For detailed information, see the "Evaluation Results" section below. ### 3. Quick Test of the Benchmark Setup @@ -192,7 +192,7 @@ Naturally, changes to the timeout or memory are expected to affect the evaluatio ---------------------------------------------------------------------------------- -## EVALUATION RESULTS +## Evaluation Results The evaluation results that form the basis for the experimental data in the paper can be found in the directory `~/witness-validation/paper-evaluation/`. The witnesses generated by Goblint that formed the basis for this evaluation can be found in `~/witness-generation/paper-evaluation/`. @@ -228,7 +228,7 @@ As described above (in section _2. Inspect the evaluation results_), the artifac ---------------------------------------------------------------------------------- -## SOURCE CODE +## Source Code ### GemCutter @@ -257,7 +257,7 @@ More recent versions of Goblint can be found at . ---------------------------------------------------------------------------------- -## VERIFIER BINARIES +## Verifier Binaries A pre-built binary of GemCutter can be found in `~/ultimate/releaseScripts/default/UGemCutter-linux/`. For information on how to execute GemCutter, consult the `README` in `~/ultimate/releaseScripts/default/UGemCutter-linux/`. @@ -272,7 +272,7 @@ For examples, see the benchmark definition files `~/witness-generation/goblint.x ---------------------------------------------------------------------------------- -## BENCHMARK PROGRAMS +## Benchmark Programs This artifact includes the benchmark programs on which we evaluated the verifiers. These benchmarks are taken from the publicly available sv-benchmarks set () @@ -281,7 +281,7 @@ The benchmarks are written in C and use POSIX threads (`pthreads`) to model conc ---------------------------------------------------------------------------------- -## EXTENDING & REUSING THIS ARTIFACT +## Extending & Reusing This Artifact * **Building a modified version of the VM:** This VM was created using the `vagrant` tool (). The `Vagrantfile` used to build the artifact, along with several other files used in the build, is included in the directory `~/artifact`. From fcc2d02afcd1bb5c4e8c140cc10f5569cc18f569 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:32:37 +0200 Subject: [PATCH 149/157] Remove horizontal rules in VMCAI25 artifact description --- docs/artifact-descriptions/vmcai25.md | 8 -------- 1 file changed, 8 deletions(-) diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md index 9f2de1c511..d53faa310a 100644 --- a/docs/artifact-descriptions/vmcai25.md +++ b/docs/artifact-descriptions/vmcai25.md @@ -7,7 +7,6 @@ The artifact is available on [Zenodo](https://doi.org/10.5281/zenodo.13863579). **The description here is provided for convenience and not maintained.** The artifact contains [Goblint at `vmcai25` git tag](https://github.com/goblint/analyzer/releases/tag/vmcai25). -------------------------------------------------------------------------------- ## Overview @@ -29,7 +28,6 @@ The next section gives instructions on how to setup and quickly get an overview The subsequent sections then describe each of these components in detail. The final section gives information on how to reuse this artifact. -------------------------------------------------------------------------------- ## Getting Started @@ -190,7 +188,6 @@ Note however: Naturally, changes to the timeout or memory are expected to affect the evaluation numbers. ----------------------------------------------------------------------------------- ## Evaluation Results @@ -226,8 +223,6 @@ Clicking on a status shows the complete GemCutter log for the benchmark run. As described above (in section _2. Inspect the evaluation results_), the artifact provides python scripts to directly extract the data shown in the paper from the benchmark results. ----------------------------------------------------------------------------------- - ## Source Code ### GemCutter @@ -255,7 +250,6 @@ The code for this paper is the following: More recent versions of Goblint can be found at . ----------------------------------------------------------------------------------- ## Verifier Binaries @@ -270,7 +264,6 @@ To build Goblint from scratch, run `make setup && make release`. Both GemCutter and Goblint can be invoked via the BenchExec benchmarking tool () which is installed in the VM. For examples, see the benchmark definition files `~/witness-generation/goblint.xml` resp. `~/witness-validation/gemcutter.xml` and the scripts `~/scripts/generate-witnesses.sh` resp. `~/scripts/validate-witnesses.sh`. ----------------------------------------------------------------------------------- ## Benchmark Programs @@ -279,7 +272,6 @@ These benchmarks are taken from the publicly available sv-benchmarks set (). The benchmarks are written in C and use POSIX threads (`pthreads`) to model concurrency. ----------------------------------------------------------------------------------- ## Extending & Reusing This Artifact From 73295e4bc72ab75a00bcb9406c054d90dde742f3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:37:32 +0200 Subject: [PATCH 150/157] Fix and add links in VMCAI25 artifact description --- docs/artifact-descriptions/vmcai25.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md index d53faa310a..8b0cabbbaf 100644 --- a/docs/artifact-descriptions/vmcai25.md +++ b/docs/artifact-descriptions/vmcai25.md @@ -36,7 +36,7 @@ The final section gives information on how to reuse this artifact. The artifact is a virtual machine (VM). Follow these steps to set it up: * If you have not done so already, install VirtualBox. - (https://www.virtualbox.org/wiki/Downloads) + () * Download the artifact. * Import the artifact via the VirtualBox UI (`File > Import Appliance`) or by running `VBoxManage import ghost-witnesses.ova`. @@ -65,7 +65,7 @@ The times for the Table 2 are given first in seconds and then pretty-printed as For a more detailed inspection and visualization of the data, take a look at the generated HTML report. Just open the file `~/witness-validation/paper-evaluation/results.2024-09-24_22-00-48.table.html` in firefox. -For detailed information, see the "Evaluation Results" section below. +For detailed information, see the ["Evaluation Results" section](#evaluation-results) below. ### 3. Quick Test of the Benchmark Setup @@ -220,7 +220,7 @@ Clicking on a status shows the complete GemCutter log for the benchmark run. > **Note:** If you are trying to view logs for individual runs through the HTML table (by clicking on the evaluation result `true` or `false`), you may encounter a warning because browsers block access to local files. Follow the instructions in the message to enable log viewing. -As described above (in section _2. Inspect the evaluation results_), the artifact provides python scripts to directly extract the data shown in the paper from the benchmark results. +As described above (in [section _2. Inspect the evaluation results_](#2-inspect-the-evaluation-results)), the artifact provides python scripts to directly extract the data shown in the paper from the benchmark results. ## Source Code From 2c90552b8e03581f4d9d83e2a90fbf0de2e25419 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 12:38:07 +0200 Subject: [PATCH 151/157] Fix duplicated path in VMCAI25 artifact description --- docs/artifact-descriptions/vmcai25.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/artifact-descriptions/vmcai25.md b/docs/artifact-descriptions/vmcai25.md index 8b0cabbbaf..282be65ff0 100644 --- a/docs/artifact-descriptions/vmcai25.md +++ b/docs/artifact-descriptions/vmcai25.md @@ -195,7 +195,7 @@ The evaluation results that form the basis for the experimental data in the pape The witnesses generated by Goblint that formed the basis for this evaluation can be found in `~/witness-generation/paper-evaluation/`. See below for detailed info to reproduce the tables and figures of the paper. -The file `~/witness-validation/paper-evaluation/~/witness-validation/paper-evaluation/` contains an HTML overview page generated by the BenchExec benchmarking tool, which displays individual results, quantile and scatter plots. Through the filtering sidebar (top right corner), detailed analyses can be made. +The file `~/witness-validation/paper-evaluation/` contains an HTML overview page generated by the BenchExec benchmarking tool, which displays individual results, quantile and scatter plots. Through the filtering sidebar (top right corner), detailed analyses can be made. The table contains the following configurations : From 1e88c86a1cd795cdde2a76166d5323e0a9e51f91 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 15:53:24 +0200 Subject: [PATCH 152/157] Add potential NOTIMEOUT to 06-symbeq/34-var_eq-exponential-context --- tests/regression/06-symbeq/34-var_eq-exponential-context.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/06-symbeq/34-var_eq-exponential-context.c b/tests/regression/06-symbeq/34-var_eq-exponential-context.c index bc478374f0..8b9b76a89e 100644 --- a/tests/regression/06-symbeq/34-var_eq-exponential-context.c +++ b/tests/regression/06-symbeq/34-var_eq-exponential-context.c @@ -1,5 +1,5 @@ // SKIP PARAM: --set ana.activated[+] var_eq - +// NOTIMEOUT? void level0(int *p) { } From 55e497387b7dc07967a494bb7f3c0a40e3128973 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 15:57:21 +0200 Subject: [PATCH 153/157] Renumber 06-symbeq/41-var_eq_multithread to fix duplicate ID --- .../{41-var_eq_multithread.c => 47-var_eq_multithread.c} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/regression/06-symbeq/{41-var_eq_multithread.c => 47-var_eq_multithread.c} (100%) diff --git a/tests/regression/06-symbeq/41-var_eq_multithread.c b/tests/regression/06-symbeq/47-var_eq_multithread.c similarity index 100% rename from tests/regression/06-symbeq/41-var_eq_multithread.c rename to tests/regression/06-symbeq/47-var_eq_multithread.c From c24821f83adacfa211fb3082192046088a22877c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 16:03:10 +0200 Subject: [PATCH 154/157] Fix double-locking in symbolic regression tests --- tests/regression/06-symbeq/20-mult_accs_nr.c | 2 +- tests/regression/06-symbeq/21-mult_accs_rc.c | 2 +- tests/regression/06-symbeq/21-mult_accs_rc.t | 10 ++++++---- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/regression/06-symbeq/20-mult_accs_nr.c b/tests/regression/06-symbeq/20-mult_accs_nr.c index 7d66e3f5d2..50c8f19a62 100644 --- a/tests/regression/06-symbeq/20-mult_accs_nr.c +++ b/tests/regression/06-symbeq/20-mult_accs_nr.c @@ -15,7 +15,7 @@ void *t_fun(void *arg) { pthread_mutex_lock(&s->mutex); s->data = 5; // NORACE s->lore = 6; // NORACE - pthread_mutex_lock(&s->mutex); + pthread_mutex_unlock(&s->mutex); return NULL; } diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.c b/tests/regression/06-symbeq/21-mult_accs_rc.c index 62550fab55..4acadb4a58 100644 --- a/tests/regression/06-symbeq/21-mult_accs_rc.c +++ b/tests/regression/06-symbeq/21-mult_accs_rc.c @@ -14,7 +14,7 @@ void *t_fun(void *arg) { pthread_mutex_lock(&s->mutex); s = get_s(); s->data = 5; // RACE! - pthread_mutex_lock(&s->mutex); + pthread_mutex_unlock(&s->mutex); return NULL; } diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.t b/tests/regression/06-symbeq/21-mult_accs_rc.t index ca2e219b05..2eacd0382e 100644 --- a/tests/regression/06-symbeq/21-mult_accs_rc.t +++ b/tests/regression/06-symbeq/21-mult_accs_rc.t @@ -3,7 +3,7 @@ Disable info messages because race summary contains (safe) memory location count $ goblint --enable warn.deterministic --disable warn.info --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 21-mult_accs_rc.c 2>&1 | tee default-output-1.txt [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:34) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) @@ -11,7 +11,8 @@ Disable info messages because race summary contains (safe) memory location count write with thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) write with [symblock:{p-lock:*.mutex}, mhp:{created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) [Warning][Unknown] locking NULL mutex (21-mult_accs_rc.c:14:3-14:32) - [Warning][Unknown] locking NULL mutex (21-mult_accs_rc.c:17:3-17:32) + [Warning][Unknown] unlocking NULL mutex (21-mult_accs_rc.c:17:3-17:34) + [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:17:3-17:34) [Warning][Unknown] locking NULL mutex (21-mult_accs_rc.c:33:3-33:24) [Warning][Unknown] unlocking NULL mutex (21-mult_accs_rc.c:35:3-35:26) [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) @@ -23,14 +24,15 @@ Disable info messages because race summary contains (safe) memory location count $ goblint --enable warn.deterministic --disable warn.info --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c 2>&1 | tee default-output-2.txt [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:34) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) [Success][Race] Memory location (struct s).data (safe): write with thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) [Warning][Unknown] locking NULL mutex (21-mult_accs_rc.c:14:3-14:32) - [Warning][Unknown] locking NULL mutex (21-mult_accs_rc.c:17:3-17:32) + [Warning][Unknown] unlocking NULL mutex (21-mult_accs_rc.c:17:3-17:34) + [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:17:3-17:34) [Warning][Unknown] locking NULL mutex (21-mult_accs_rc.c:33:3-33:24) [Warning][Unknown] unlocking NULL mutex (21-mult_accs_rc.c:35:3-35:26) [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) From 87ce3a5788ff89ffb931414ae29a6ca26442f6f5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 10 Dec 2024 16:05:11 +0200 Subject: [PATCH 155/157] Comment reversal of PartitionDomain.SetSet --- src/domain/partitionDomain.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/domain/partitionDomain.ml b/src/domain/partitionDomain.ml index 316f4fb705..e97946e463 100644 --- a/src/domain/partitionDomain.ml +++ b/src/domain/partitionDomain.ml @@ -106,6 +106,9 @@ struct let show _ = "Partitions" + (* Top and bottom are reversed: + Bottom will be All (equations), i.e. contradiction, + Top will be empty set, i.e. no equations. *) let top = E.bot let bot = E.top let is_top = E.is_bot From 4a9b52f57702586b1e876cde83bdedac3119b6f6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 16 Dec 2024 10:56:50 +0200 Subject: [PATCH 156/157] Fix invalid widen call in slr3 for globals --- src/solver/sLR.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/solver/sLR.ml b/src/solver/sLR.ml index 69d415307a..299bbbce52 100644 --- a/src/solver/sLR.ml +++ b/src/solver/sLR.ml @@ -66,7 +66,7 @@ module SLR3 = if tracing then trace "sol" "Contrib:%a" S.Dom.pretty tmp; let tmp = if wpx then - if HM.mem globals x then S.Dom.widen old tmp (* TODO: no join in second argument, can call widen incorrectly? *) + if HM.mem globals x then S.Dom.widen old (S.Dom.join old tmp) else box old tmp else tmp in From b0243f91c6a3013d797b7a6cde8c59a605cfe0c4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 16 Dec 2024 11:00:43 +0200 Subject: [PATCH 157/157] Disable broken two solver --- src/solver/sLR.ml | 2 +- tests/regression/00-sanity/01-assert.t | 115 ------------------------- 2 files changed, 1 insertion(+), 116 deletions(-) diff --git a/src/solver/sLR.ml b/src/solver/sLR.ml index 299bbbce52..03ba9307aa 100644 --- a/src/solver/sLR.ml +++ b/src/solver/sLR.ml @@ -527,7 +527,7 @@ let _ = Selector.add_solver ("widen2", (module PostSolver.EqIncrSolverFromEqSolver (W2))); Selector.add_solver ("widen3", (module PostSolver.EqIncrSolverFromEqSolver (W3))); let module S2 = TwoPhased (struct let ver = 1 end) in - Selector.add_solver ("two", (module PostSolver.EqIncrSolverFromEqSolver (S2))); (* TODO: broken even on 00-sanity/01-assert *) + (* Selector.add_solver ("two", (module PostSolver.EqIncrSolverFromEqSolver (S2))); (* TODO: broken even on 00-sanity/01-assert *) *) let module S1 = Make (struct let ver = 1 end) in Selector.add_solver ("new", (module PostSolver.EqIncrSolverFromEqSolver (S1))); Selector.add_solver ("slr+", (module PostSolver.EqIncrSolverFromEqSolver (S1))) diff --git a/tests/regression/00-sanity/01-assert.t b/tests/regression/00-sanity/01-assert.t index cd8c4c06f8..9b3b55f530 100644 --- a/tests/regression/00-sanity/01-assert.t +++ b/tests/regression/00-sanity/01-assert.t @@ -139,121 +139,6 @@ Test SLR solvers: dead: 2 total lines: 9 - $ goblint --enable warn.deterministic --set solver two 01-assert.c - [Error] Fixpoint not reached at L:entry state of main (299) on 01-assert.c:4:1-15:1 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), - mallocWrapper:(wrapper call:Unknown node, unique calls:{}), - base:({ - }, {}, {}, {}), - threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), - threadflag:Singlethreaded, - threadreturn:true, - escape:{}, - mutexEvents:(), - access:(), - mutex:(lockset:{}, multiplicity:{}), - race:(), - mhp:(), - assert:(), - pthreadMutexType:()], map:{})} - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):PathSensitive (ProjectiveSet (MCP.D * map)):{(MCP.D:[expRelation:(), - mallocWrapper:(wrapper call:Unknown node, unique calls:{}), - base:({ - }, {}, {}, {}), - threadid:(wrapper call:unknown node, Thread:[main], created:(current function:bot, callees:bot)), - threadflag:Singlethreaded, - threadreturn:true, - escape:{}, - mutexEvents:(), - access:(), - mutex:(lockset:{}, multiplicity:{}), - race:(), - mhp:(), - assert:(), - pthreadMutexType:()], map:{})} instead of bot - - [Error] Fixpoint not reached at L:node 1 "success = 1;" on 01-assert.c:5:7-5:18 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node 2 "silence = 1;" on 01-assert.c:6:7-6:18 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node 3 "fail = 0;" on 01-assert.c:7:7-7:15 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node 4 "__goblint_assert(success);" on 01-assert.c:10:3-10:28 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node 5 "__goblint_assert(unknown == 4);" on 01-assert.c:11:3-11:33 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node 6 "__goblint_assert(fail);" on 01-assert.c:12:3-12:25 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node 7 "return (0);" on 01-assert.c:13:10-13:11 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node 9 "__goblint_assert(silence);" on 01-assert.c:14:3-14:28 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:node -299 "return;" on 01-assert.c:15:1-15:1 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Error] Fixpoint not reached at L:call of main (299) on 01-assert.c:4:1-15:1 - Solver computed: - bot - Right-Hand-Side: - HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code - Difference: HConsed lifted PathSensitive (ProjectiveSet (MCP.D * map)):Dead code instead of bot - - [Warning][Deadcode] Function 'main' does not return - [Warning][Deadcode] Function 'main' is uncalled: 8 LLoC (01-assert.c:4:1-15:1) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 0 - dead: 8 (8 in uncalled functions) - total lines: 8 - [Error][Unsound] Fixpoint not reached - [3] - $ goblint --enable warn.deterministic --set solver new 01-assert.c [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33)