diff --git a/.gitignore b/.gitignore
index 9d288ec6a3..244a770394 100644
--- a/.gitignore
+++ b/.gitignore
@@ -52,3 +52,5 @@ goblint.bc.js
*.orig
sv-comp/goblint.zip
+
+privPrecCompare*/
diff --git a/conf/traces.json b/conf/traces.json
new file mode 100644
index 0000000000..b225326b57
--- /dev/null
+++ b/conf/traces.json
@@ -0,0 +1,43 @@
+{
+ "ana": {
+ "int": {
+ "def_exc": true,
+ "interval": false,
+ "enums": true
+ }
+ },
+ "sem": {
+ "unknown_function": {
+ "invalidate": {
+ "globals": false
+ },
+ "spawn": true
+ },
+ "builtin_unreachable": {
+ "dead_code": true
+ }
+ },
+ "exp": {
+ "priv-distr-init": 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"
+ ]
+ }
+ }
+}
diff --git a/scripts/privPrecCompare-creduce.sh b/scripts/privPrecCompare-creduce.sh
new file mode 100755
index 0000000000..331cb7f44e
--- /dev/null
+++ b/scripts/privPrecCompare-creduce.sh
@@ -0,0 +1,32 @@
+#!/bin/bash
+
+# creduce ./scripts/privPrecCompare-creduce.sh ./pfscan_comb.c
+
+set -e
+
+gcc -c -Werror=implicit-function-declaration ./tegra20.c
+
+GOBLINTDIR="/home/simmo/dev/goblint/sv-comp/goblint"
+# OPTS="./pfscan_comb.c --enable custom_libc"
+OPTS="./tegra20.c --conf $GOBLINTDIR/conf/traces.json --enable ana.sv-comp.functions"
+# PRIVS=(protection protection-read write mine-W lock write+lock)
+PRIVS=(protection write)
+INTERESTING="protection more precise than write"
+OUTDIR="privPrecCompare-creduce"
+
+
+mkdir -p $OUTDIR
+
+for PRIV in "${PRIVS[@]}"; do
+ echo $PRIV
+ PRIVDUMP="$OUTDIR/$PRIV"
+ LOG="$OUTDIR/$PRIV.log"
+ rm -f $PRIVDUMP
+ $GOBLINTDIR/goblint --sets exp.privatization $PRIV --sets exp.priv-prec-dump $PRIVDUMP $OPTS -v --enable dbg.debug &> $LOG
+ grep -F "Function definition missing" $LOG && exit 1
+done
+
+PRIVDUMPS=("${PRIVS[*]/#/$OUTDIR/}") # why [*] here?
+$GOBLINTDIR/_build/default/src/privPrecCompare.exe $PRIVDUMPS 2>&1 | tee "$OUTDIR/compare.txt"
+
+grep -F "$INTERESTING" "$OUTDIR/compare.txt"
\ No newline at end of file
diff --git a/scripts/privPrecCompare.sh b/scripts/privPrecCompare.sh
new file mode 100755
index 0000000000..5af26d4ca1
--- /dev/null
+++ b/scripts/privPrecCompare.sh
@@ -0,0 +1,17 @@
+#!/bin/bash
+
+# ./scripts/privPrecCompare.sh ../goblint-bench/pthread/pfscan_comb.c --enable custom_libc
+
+PRIVS=(protection protection-read write mine-W lock write+lock)
+OUTDIR="privPrecCompare"
+
+mkdir -p $OUTDIR
+
+for PRIV in "${PRIVS[@]}"; do
+ echo $PRIV
+ PRIVDUMP="$OUTDIR/$PRIV"
+ ./goblint --sets exp.privatization $PRIV --sets exp.priv-prec-dump $PRIVDUMP "$@"
+done
+
+PRIVDUMPS=("${PRIVS[*]/#/$OUTDIR/}") # why [*] here?
+./_build/default/src/privPrecCompare.exe $PRIVDUMPS 2>&1 | tee "$OUTDIR/compare.txt"
diff --git a/scripts/update_suite.rb b/scripts/update_suite.rb
index 0d7ba66d7e..a5ccb4bb66 100755
--- a/scripts/update_suite.rb
+++ b/scripts/update_suite.rb
@@ -1,5 +1,7 @@
#!/usr/bin/env ruby
+# gobopt environment variable can be used to override goblint defaults and PARAMs
+
require 'find'
require 'fileutils'
require 'timeout'
@@ -116,6 +118,7 @@ def to_s
next unless thegroup.nil? or groupname == thegroup or # group x = only group x
(thegroup.start_with?"-" and groupname != thegroup[1..-1]) # group -x = all groups but x
grouppath = File.expand_path(d, testfiles)
+ next unless File.directory?(grouppath)
group = Dir.open(grouppath)
group.sort.each do |f|
next if File.basename(f)[0] == ?.
@@ -230,7 +233,7 @@ def to_s
pgid = Process.getpgid(pid)
puts "\t #{id} reached timeout of #{timeout}s!".red + " Killing pgid #{pgid}..."
timedout.push id
- Process.kill('INT', -1*pgid)
+ Process.kill('KILL', -1*pgid)
p.ok = false
return p
end
diff --git a/src/analyses/arinc.ml b/src/analyses/arinc.ml
index cc895ee65a..b61fc23462 100644
--- a/src/analyses/arinc.ml
+++ b/src/analyses/arinc.ml
@@ -32,16 +32,16 @@ module Functions = struct
else
match List.last args with
| AddrOf lv ->
- Some (fun set ->
+ Some (
let ret = if GobConfig.get_bool "ana.arinc.assume_success" then ret_success else if List.mem fname with_timeout then ret_any else ret_no_timeout in
let v = vd ret in
debug_doc @@ Pretty.dprintf "effect of %s: set %a to %a" fname d_lval lv ValueDomain.Compound.pretty v;
- set lv v
+ [(lv, v)]
)
| _ -> None
end
-module Spec : Analyses.Spec =
+module Spec : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
@@ -260,7 +260,8 @@ struct
(* M.debug_each @@ "BODY " ^ f.svar.vname ^" @ "^ string_of_int (!Tracing.current_loc).line; *)
(* if not (is_single ctx || !Goblintutil.global_initialization || fst (ctx.global part_mode_var)) then raise Analyses.Deadcode; *)
(* checkPredBot ctx.local "body" f.svar [] *)
- let base_context = Base.Main.context_cpa @@ Obj.obj @@ List.assoc "base" ctx.presub in
+ let module BaseMain = (val Base.get_main ()) in
+ let base_context = BaseMain.context_cpa @@ Obj.obj @@ List.assoc "base" ctx.presub in
let context_hash = Hashtbl.hash (base_context, ctx.local.pid) in
{ ctx.local with ctx = Ctx.of_int (Int64.of_int context_hash) }
@@ -662,10 +663,10 @@ struct
) tasks
in
let f_d = snd (Tasks.choose tasks_f) in
- { f_d with pre = d.pre }
+ [{ f_d with pre = d.pre }]
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadspawn ctx lval f args fctx = ctx.local
end
let _ =
- MCP.register_analysis ~dep:["base"] (module Spec : Spec)
+ MCP.register_analysis ~dep:["base"] (module Spec : MCPSpec)
diff --git a/src/analyses/base.ml b/src/analyses/base.ml
index 54e72d819b..7e54d23e70 100644
--- a/src/analyses/base.ml
+++ b/src/analyses/base.ml
@@ -3,6 +3,7 @@
open Prelude.Ana
open Analyses
open GobConfig
+open BaseUtil
module A = Analyses
module H = Hashtbl
module Q = Queries
@@ -18,46 +19,27 @@ module LF = LibraryFunctions
module CArrays = ValueDomain.CArrays
module BI = IntOps.BigIntOps
-let is_global (a: Q.ask) (v: varinfo): bool =
- v.vglob || ThreadEscape.has_escaped a v
+module VD = BaseDomain.VD
+module CPA = BaseDomain.CPA
+module Dep = BaseDomain.PartDeps
+module BaseComponents = BaseDomain.BaseComponents
-let is_static (v:varinfo): bool = v.vstorage == Static
-let precious_globs = ref []
-let is_precious_glob v = List.exists (fun x -> v.vname = Json.string x) !precious_globs
-let privatization = ref false
-let is_private (a: Q.ask) (_,_) (v: varinfo): bool =
- !privatization && (* must be true *)
- (not (ThreadFlag.is_multi a) && is_precious_glob v (* not multi, but precious (earlyglobs) *)
- || match a (Q.MayBePublic v) with `MayBool tv -> not tv | _ -> false) (* usual case where MayBePublic answers *)
-
-module MainFunctor(RVEval:BaseDomain.ExpEvaluator) =
+module MainFunctor (Priv:BasePriv.S) (RVEval:BaseDomain.ExpEvaluator with type t = BaseComponents (Priv.D).t) =
struct
include Analyses.DefaultSpec
exception Top
- module VD = BaseDomain.VD
- module CPA = BaseDomain.CPA
- module Dep = BaseDomain.PartDeps
-
- module Dom = BaseDomain.DomFunctor(RVEval)
+ module Dom = BaseDomain.DomFunctor (Priv.D) (RVEval)
+ type t = Dom.t
- module G = BaseDomain.VD
+ module G = Priv.G
module D = Dom
module C = Dom
module V = Basetype.Variables
-
- let name () = "base"
- let startstate v = CPA.bot (), Dep.bot ()
- let exitstate v = CPA.bot (), Dep.bot ()
-
-
- let morphstate v (cpa,dep) = cpa, dep
-
- type cpa = CPA.t
type extra = (varinfo * Offs.t * bool) list
type store = D.t
type value = VD.t
@@ -65,6 +47,11 @@ struct
type glob_fun = V.t -> G.t
type glob_diff = (V.t * G.t) list
+ let name () = "base"
+ let startstate v: store = { cpa = CPA.bot (); deps = Dep.bot (); priv = Priv.startstate ()}
+ let otherstate v: store = { cpa = CPA.bot (); deps = Dep.bot (); priv = Priv.startstate ()}
+ let exitstate v: store = { cpa = CPA.bot (); deps = Dep.bot (); priv = Priv.startstate ()}
+
(**************************************************************************
* Helpers
**************************************************************************)
@@ -93,10 +80,15 @@ struct
| _ -> failwith("Ran without a malloc analysis.") in
info
+ (* hack for char a[] = {"foo"} or {'f','o','o', '\000'} *)
+ let char_array : (lval, bytes) Hashtbl.t = Hashtbl.create 500
+
let init () =
- privatization := get_bool "exp.privatization";
- precious_globs := get_list "exp.precious_globs";
- return_varstore := Goblintutil.create_var @@ makeVarinfo false "RETURN" voidType
+ return_varstore := Goblintutil.create_var @@ makeVarinfo false "RETURN" voidType;
+ Priv.init ()
+
+ let finalize () =
+ Priv.finalize ()
(**************************************************************************
* Abstract evaluation functions
@@ -326,58 +318,45 @@ struct
* State functions
**************************************************************************)
- let globalize ?(privates=false) a (cpa,dep): cpa * glob_diff =
- (* For each global variable, we create the diff *)
- let add_var (v: varinfo) (value) (cpa,acc) =
- if M.tracing then M.traceli "globalize" ~var:v.vname "Tracing for %s\n" v.vname;
- let res =
- if is_global a v && ((privates && not (is_precious_glob v)) || not (is_private a (cpa,dep) v)) then begin
- if M.tracing then M.tracec "globalize" "Publishing its value: %a\n" VD.pretty value;
- (CPA.remove v cpa, (v,value) :: acc)
- end else
- (cpa,acc)
- in
- if M.tracing then M.traceu "globalize" "Done!\n";
- res
+ let sync' reason ctx: D.t * glob_diff =
+ let multi =
+ match reason with
+ | `Init
+ | `Thread ->
+ true
+ | _ ->
+ ThreadFlag.is_multi ctx.ask
in
- (* We fold over the local state, and collect the globals *)
- CPA.fold add_var cpa (cpa, [])
+ if M.tracing then M.tracel "sync" "sync multi=%B earlyglobs=%B\n" multi !GU.earlyglobs;
+ if !GU.earlyglobs || multi then Priv.sync ctx.ask ctx.global ctx.local reason else (ctx.local,[])
- let sync' privates multi ctx: D.t * glob_diff =
- let cpa,dep = ctx.local in
- let privates = privates || (!GU.earlyglobs && not multi) in
- let cpa, diff = if !GU.earlyglobs || multi then globalize ~privates:privates ctx.ask ctx.local else (cpa,[]) in
- (cpa, dep), diff
+ let sync ctx reason = sync' (reason :> [`Normal | `Join | `Return | `Init | `Thread]) ctx
- let sync ctx = sync' false (ThreadFlag.is_multi ctx.ask) ctx
+ let publish_all ctx reason =
+ List.iter (fun ((x,d)) -> ctx.sideg x d) (snd (sync' reason ctx))
- let publish_all ctx =
- List.iter (fun ((x,d)) -> ctx.sideg x d) (snd (sync' true true ctx))
+ let get_var (a: Q.ask) (gs: glob_fun) (st: store) (x: varinfo): value =
+ if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then
+ Priv.read_global a gs st x
+ else begin
+ if M.tracing then M.tracec "get" "Singlethreaded mode.\n";
+ CPA.find x st.cpa
+ end
(** [get st addr] returns the value corresponding to [addr] in [st]
* adding proper dependencies.
* For the exp argument it is always ok to put None. This means not using precise information about
* which part of an array is involved. *)
- let rec get ?(full=false) a (gs: glob_fun) (st,dep: store) (addrs:address) (exp:exp option): value =
+ let rec get ?(full=false) a (gs: glob_fun) (st: store) (addrs:address) (exp:exp option): value =
let at = AD.get_type addrs in
let firstvar = if M.tracing then try (List.hd (AD.to_var_may addrs)).vname with _ -> "" else "" in
- let get_global x = gs x in
- if M.tracing then M.traceli "get" ~var:firstvar "Address: %a\nState: %a\n" AD.pretty addrs CPA.pretty st;
+ if M.tracing then M.traceli "get" ~var:firstvar "Address: %a\nState: %a\n" AD.pretty addrs CPA.pretty st.cpa;
(* Finding a single varinfo*offset pair *)
let res =
let f_addr (x, offs) =
(* get hold of the variable value, either from local or global state *)
- let var = if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then
- match CPA.find x st with
- | `Bot -> (if M.tracing then M.tracec "get" "Using global invariant.\n"; get_global x)
- | x -> (if M.tracing then M.tracec "get" "Using privatized version.\n"; x)
- else begin
- if M.tracing then M.tracec "get" "Singlethreaded mode.\n";
- CPA.find x st
- end
- in
-
- let v = VD.eval_offset a (fun x -> get a gs (st,dep) x exp) var offs exp (Some (Var x, Offs.to_cil_offset offs)) x.vtype in
+ let var = get_var a gs st x in
+ let v = VD.eval_offset a (fun x -> get a gs st x exp) var offs exp (Some (Var x, Offs.to_cil_offset offs)) x.vtype in
if M.tracing then M.tracec "get" "var = %a, %a = %a\n" VD.pretty var AD.pretty (AD.from_var_offset (x, offs)) VD.pretty v;
if full then v else match v with
| `Blob (c,s,_) -> c
@@ -401,8 +380,6 @@ struct
if M.tracing then M.traceu "get" "Result: %a\n" VD.pretty res;
res
- let is_always_unknown variable = variable.vstorage = Extern || Ciltools.is_volatile_tp variable.vtype
-
(**************************************************************************
* Auxiliary functions for function calls
@@ -523,15 +500,15 @@ struct
let drop_interval = CPA.map (function `Int x -> `Int (ID.no_interval x) | x -> x)
- let context (cpa,dep) =
- let f t f (cpa,dep) = if t then f cpa, dep else cpa, dep in
- (cpa,dep) |>
+ let context (st: store): store =
+ let f t f (st: store) = if t then { st with cpa = f st.cpa} else st in
+ st |>
f !GU.earlyglobs (CPA.filter (fun k v -> not (V.is_global k) || is_precious_glob k))
%> f (get_bool "exp.addr-context") drop_non_ptrs
%> f (get_bool "exp.no-int-context") drop_ints
%> f (get_bool "exp.no-interval-context") drop_interval
- let context_cpa (cpa,dep) = fst @@ context (cpa,dep)
+ let context_cpa (st: store) = (context st).cpa
let convertToQueryLval x =
let rec offsNormal o =
@@ -819,7 +796,7 @@ struct
let eval_exp x (exp:exp) =
(* Since ctx is not available here, we need to make some adjustments *)
let knownothing = fun _ -> `Top in (* our version of ask *)
- let gs = fun _ -> `Top in (* the expression is guaranteed to not contain globals *)
+ let gs = fun _ -> G.top () in (* the expression is guaranteed to not contain globals *)
match (eval_rv knownothing gs x exp) with
| `Int x -> ValueDomain.ID.to_int x
| _ -> None
@@ -990,14 +967,14 @@ struct
end
| _ -> Q.Result.top ()
- let update_variable variable value state =
+ let update_variable variable typ value cpa =
if ((get_bool "exp.volatiles_are_top") && (is_always_unknown variable)) then
- CPA.add variable (VD.top ()) state
+ CPA.add variable (VD.top_value typ) cpa
else
- CPA.add variable value state
+ CPA.add variable value cpa
(** Add dependencies between a value and the expression it (or any of its contents) are partitioned by *)
- let add_partitioning_dependencies (x:varinfo) (value:VD.t) (st,dep:store):store =
+ let add_partitioning_dependencies (x:varinfo) (value:VD.t) (st:store):store =
let add_one_dep (array:varinfo) (var:varinfo) dep =
let vMap = Dep.find_opt var dep |? Dep.VarSet.empty () in
let vMapNew = Dep.VarSet.add array vMap in
@@ -1009,28 +986,29 @@ struct
| `Union _ ->
begin
let vars_in_paritioning = VD.affecting_vars value in
- let dep_new = List.fold_left (fun dep var -> add_one_dep x var dep) dep vars_in_paritioning in
- (st, dep_new)
+ let dep_new = List.fold_left (fun dep var -> add_one_dep x var dep) st.deps vars_in_paritioning in
+ { st with deps = dep_new }
end
(* `List and `Blob cannot contain arrays *)
- | _ -> (st, dep)
+ | _ -> st
(** [set st addr val] returns a state where [addr] is set to [val]
* it is always ok to put None for lval_raw and rval_raw, this amounts to not using/maintaining
* precise information about arrays. *)
- let set a ?(ctx=None) ?(effect=true) ?(change_array=true) ?lval_raw ?rval_raw ?t_override (gs:glob_fun) (st,dep: store) (lval: AD.t) (lval_type: Cil.typ) (value: value) : store =
- let update_variable x y z =
+ let set a ?(ctx=None) ?(effect=true) ?(change_array=true) ?lval_raw ?rval_raw ?t_override (gs:glob_fun) (st: store) (lval: AD.t) (lval_type: Cil.typ) (value: value) : store =
+ let update_variable x t y z =
if M.tracing then M.tracel "setosek" ~var:x.vname "update_variable: start '%s' '%a'\nto\n%a\n\n" x.vname VD.pretty y CPA.pretty z;
- let r = update_variable x y z in (* refers to defintion that is outside of set *)
+ let r = update_variable x t y z in (* refers to defintion that is outside of set *)
if M.tracing then M.tracel "setosek" ~var:x.vname "update_variable: start '%s' '%a'\nto\n%a\nresults in\n%a\n" x.vname VD.pretty y CPA.pretty z CPA.pretty r;
r
in
let firstvar = if M.tracing then try (List.hd (AD.to_var_may lval)).vname with _ -> "" else "" in
- if M.tracing then M.tracel "set" ~var:firstvar "lval: %a\nvalue: %a\nstate: %a\n" AD.pretty lval VD.pretty value CPA.pretty st;
+ let lval_raw = (Option.map (fun x -> Lval x) lval_raw) in
+ if M.tracing then M.tracel "set" ~var:firstvar "lval: %a\nvalue: %a\nstate: %a\n" AD.pretty lval VD.pretty value CPA.pretty st.cpa;
(* Updating a single varinfo*offset pair. NB! This function's type does
* not include the flag. *)
- let update_one_addr (x, offs) (nst, dep): store =
+ let update_one_addr (x, offs) (st: store): store =
let cil_offset = Offs.to_cil_offset offs in
let t = match t_override with
| Some t -> t
@@ -1049,45 +1027,33 @@ struct
M.warn ("Cil.typeOfLval failed Could not obtain the type of "^ sprint d_lval (Var x, cil_offset));
lval_type
in
- if M.tracing then M.tracel "setosek" ~var:firstvar "update_one_addr: start with '%a' (type '%a') \nstate:%a\n\n" AD.pretty (AD.from_var_offset (x,offs)) d_type x.vtype CPA.pretty st;
+ if M.tracing then M.tracel "setosek" ~var:firstvar "update_one_addr: start with '%a' (type '%a') \nstate:%a\n\n" AD.pretty (AD.from_var_offset (x,offs)) d_type x.vtype D.pretty st;
if isFunctionType x.vtype then begin
if M.tracing then M.tracel "setosek" ~var:firstvar "update_one_addr: returning: '%a' is a function type \n" d_type x.vtype;
- nst, dep
+ st
end else
if get_bool "exp.globs_are_top" then begin
if M.tracing then M.tracel "setosek" ~var:firstvar "update_one_addr: BAD? exp.globs_are_top is set \n";
- CPA.add x `Top nst, dep
+ { st with cpa = CPA.add x `Top st.cpa }
end else
(* Check if we need to side-effect this one. We no longer generate
* side-effects here, but the code still distinguishes these cases. *)
- if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then
- (* Check if we should avoid producing a side-effect, such as updates to
- * the state when following conditional guards. *)
- if not effect && not (is_private a (st,dep) x) then begin
- if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: BAD! effect = '%B', or else is private! \n" effect;
- nst, dep
- end else begin
- let get x st =
- match CPA.find x st with
- | `Bot -> (if M.tracing then M.tracec "set" "Reading from global invariant.\n"; gs x)
- | x -> (if M.tracing then M.tracec "set" "Reading from privatized version.\n"; x)
- in
- if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: update a global var '%s' ...\n" x.vname;
- (* Here, an effect should be generated, but we add it to the local
- * state, waiting for the sync function to publish it. *)
- update_variable x (VD.update_offset a (get x nst) offs value (Option.map (fun x -> Lval x) lval_raw) (Var x, cil_offset) t) nst, dep
- end
- else begin
+ if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then begin
+ if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: update a global var '%s' ...\n" x.vname;
+ let var = Priv.read_global a gs st x in
+ let r = Priv.write_global ~invariant:(not effect) a gs (Option.get ctx).sideg st x (VD.update_offset a var offs value lval_raw (Var x, cil_offset) t) in
+ if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: updated a global var '%s' \nstate:%a\n\n" x.vname D.pretty r;
+ r
+ end else begin
if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: update a local var '%s' ...\n" x.vname;
(* Normal update of the local state *)
- let lval_raw = (Option.map (fun x -> Lval x) lval_raw) in
- let new_value = VD.update_offset a (CPA.find x nst) offs value lval_raw ((Var x), cil_offset) t in
+ let new_value = VD.update_offset a (CPA.find x st.cpa) offs value lval_raw ((Var x), cil_offset) t in
(* what effect does changing this local variable have on arrays -
we only need to do this here since globals are not allowed in the
expressions for partitioning *)
- let effect_on_arrays a (st, dep)=
+ let effect_on_arrays a (st: store) =
let affected_arrays =
- let set = Dep.find_opt x dep |? Dep.VarSet.empty () in
+ let set = Dep.find_opt x st.deps |? Dep.VarSet.empty () in
Dep.VarSet.elements set
in
let movement_for_expr l' r' currentE' =
@@ -1108,8 +1074,8 @@ struct
else
None
in
- let effect_on_array actually_moved arr (st,dep):store =
- let v = CPA.find arr st in
+ let effect_on_array actually_moved arr (st: store):store =
+ let v = CPA.find arr st.cpa in
let nval =
if actually_moved then
match lval_raw, rval_raw with
@@ -1124,7 +1090,7 @@ struct
let patched_ask =
match ctx with
| Some ctx ->
- let patched = swap_st ctx (st,dep) in
+ let patched = swap_st ctx st in
query patched
| _ ->
a
@@ -1132,14 +1098,14 @@ struct
let moved_by = fun x -> Some 0 in (* this is ok, the information is not provided if it *)
VD.affect_move patched_ask v x moved_by (* was a set call caused e.g. by a guard *)
in
- update_variable arr nval st, dep
+ { st with cpa = update_variable arr arr.vtype nval st.cpa }
in
(* change_array is false if a change to the way arrays are partitioned is not necessary *)
(* for now, this is only the case when guards are evaluated *)
- List.fold_left (fun x y -> effect_on_array change_array y x) (st,dep) affected_arrays
+ List.fold_left (fun x y -> effect_on_array change_array y x) st affected_arrays
in
- let x_updated = update_variable x new_value nst in
- let with_dep = add_partitioning_dependencies x new_value (x_updated, dep) in
+ let x_updated = update_variable x t new_value st.cpa in
+ let with_dep = add_partitioning_dependencies x new_value {st with cpa = x_updated } in
effect_on_arrays a with_dep
end
in
@@ -1150,49 +1116,49 @@ struct
in try
(* We start from the current state and an empty list of global deltas,
* and we assign to all the the different possible places: *)
- let nst = AD.fold update_one lval (st, dep) in
+ let nst = AD.fold update_one lval st in
(* if M.tracing then M.tracel "setosek" ~var:firstvar "new state1 %a\n" CPA.pretty nst; *)
(* If the address was definite, then we just return it. If the address
* was ambiguous, we have to join it with the initial state. *)
- let nst = if AD.cardinal lval > 1 then (CPA.join st (fst nst), dep) else nst in
+ let nst = if AD.cardinal lval > 1 then { nst with cpa = CPA.join st.cpa nst.cpa } else nst in
(* if M.tracing then M.tracel "setosek" ~var:firstvar "new state2 %a\n" CPA.pretty nst; *)
nst
with
(* If any of the addresses are unknown, we ignore it!?! *)
| SetDomain.Unsupported x ->
(* if M.tracing then M.tracel "setosek" ~var:firstvar "set got an exception '%s'\n" x; *)
- M.warn_each "Assignment to unknown address"; (st,dep)
+ M.warn_each "Assignment to unknown address"; st
- let set_many a (gs:glob_fun) (st,dep as store: store) lval_value_list: store =
+ let set_many ?ctx a (gs:glob_fun) (st: store) lval_value_list: store =
(* Maybe this can be done with a simple fold *)
let f (acc: store) ((lval:AD.t),(typ:Cil.typ),(value:value)): store =
- set a gs acc lval typ value
+ set ~ctx a gs acc lval typ value
in
(* And fold over the list starting from the store turned wstore: *)
- List.fold_left f store lval_value_list
+ List.fold_left f st lval_value_list
- let rem_many a (st,dep: store) (v_list: varinfo list): store =
+ let rem_many a (st: store) (v_list: varinfo list): store =
let f acc v = CPA.remove v acc in
let g dep v = Dep.remove v dep in
- List.fold_left f st v_list, List.fold_left g dep v_list
+ { st with cpa = List.fold_left f st.cpa v_list; deps = List.fold_left g st.deps v_list }
(* Removes all partitionings done according to this variable *)
- let rem_many_paritioning a (s:store) (v_list: varinfo list):store =
+ let rem_many_paritioning a (st:store) (v_list: varinfo list):store =
(* Removes the partitioning information from all affected arrays, call before removing locals *)
- let rem_partitioning a (st,dep:store) (x:varinfo):store =
+ let rem_partitioning a (st:store) (x:varinfo):store =
let affected_arrays =
- let set = Dep.find_opt x dep |? Dep.VarSet.empty () in
+ let set = Dep.find_opt x st.deps |? Dep.VarSet.empty () in
Dep.VarSet.elements set
in
let effect_on_array arr st =
let v = CPA.find arr st in
let nval = VD.affect_move ~replace_with_const:(get_bool ("exp.partition-arrays.partition-by-const-on-return")) a v x (fun _ -> None) in (* Having the function for movement return None here is equivalent to forcing the partitioning to be dropped *)
- update_variable arr nval st
+ update_variable arr arr.vtype nval st
in
- let nst = List.fold_left (fun x y -> effect_on_array y x) st affected_arrays in
- (nst, dep) in
+ { st with cpa = List.fold_left (fun x y -> effect_on_array y x) st.cpa affected_arrays }
+ in
let f s v = rem_partitioning a s v in
- List.fold_left f s v_list
+ List.fold_left f st v_list
(**************************************************************************
* Auxillary functions
@@ -1361,11 +1327,11 @@ struct
M.warn_each ("Invariant failed: expression \"" ^ sprint d_plainexp exp ^ "\" not understood.");
st
- let invariant ctx a gs st exp tv =
+ let invariant ctx a gs st exp tv: store =
let open Deriving.Cil in
- let fallback reason =
+ let fallback reason st =
if M.tracing then M.tracel "inv" "Can't handle %a.\n%s\n" d_plainexp exp reason;
- fst (invariant ctx a gs st exp tv)
+ invariant ctx a gs st exp tv
in
(* inverse values for binary operation a `op` b == c *)
(* ikind is the type of a for limiting ranges of the operands a, b. The only binops which can have different types for a, b are Shiftlt, Shiftrt (not handled below; don't use ikind to limit b there). *)
@@ -1479,10 +1445,10 @@ struct
if M.tracing then M.tracel "inv" "Unhandled operator %s\n" (show_binop op);
a, b
in
- let eval e = eval_rv a gs st e in
- let eval_bool e = match eval e with `Int i -> ID.to_bool i | _ -> None in
- let set' lval v = fst (set a gs st (eval_lv a gs st lval) (Cil.typeOfLval lval) v ~effect:false ~change_array:false ~ctx:(Some ctx)) in
- let rec inv_exp c exp =
+ let eval e st = eval_rv a gs st e in
+ let eval_bool e st = match eval e st with `Int i -> ID.to_bool i | _ -> None in
+ let set' lval v st = set a gs st (eval_lv a gs st lval) (Cil.typeOfLval lval) v ~effect:false ~change_array:false ~ctx:(Some ctx) in
+ let rec inv_exp c exp (st:store): store =
(* trying to improve variables in an expression so it is bottom means dead code *)
if ID.is_bot c then raise Deadcode;
match exp with
@@ -1497,25 +1463,22 @@ struct
| Some false -> ID.of_bool (Cilfacade.get_ikind (typeOf e)) false
| _ -> ID.top_of (Cilfacade.get_ikind (typeOf e))
in
- inv_exp c' e
- | UnOp ((BNot|Neg) as op, e, _) -> inv_exp (unop_ID op c) e
+ inv_exp c' e st
+ | UnOp ((BNot|Neg) as op, e, _) -> inv_exp (unop_ID op c) e st
| BinOp(op, CastE (t1, c1), CastE (t2, c2), t) when (op = Eq || op = Ne) && typeSig (typeOf c1) = typeSig (typeOf c2) && VD.is_safe_cast t1 (typeOf c1) && VD.is_safe_cast t2 (typeOf c2) ->
- inv_exp c (BinOp (op, c1, c2, t))
+ inv_exp c (BinOp (op, c1, c2, t)) st
| BinOp (op, e1, e2, _) as e ->
- if M.tracing then M.tracel "inv" "binop %a with %a %s %a == %a\n" d_exp e VD.pretty (eval e1) (show_binop op) VD.pretty (eval e2) ID.pretty c;
- (match eval e1, eval e2 with
+ if M.tracing then M.tracel "inv" "binop %a with %a %s %a == %a\n" d_exp e VD.pretty (eval e1 st) (show_binop op) VD.pretty (eval e2 st) ID.pretty c;
+ (match eval e1 st, eval e2 st with
| `Int a, `Int b ->
let ikind = Cilfacade.get_ikind @@ typeOf e1 in (* both operands have the same type (except for Shiftlt, Shiftrt)! *)
let a', b' = inv_bin_int (a, b) ikind c op in
if M.tracing then M.tracel "inv" "binop: %a, a': %a, b': %a\n" d_exp e ID.pretty a' ID.pretty b';
- let m1 = try Some (inv_exp a' e1) with Deadcode -> None in
- let m2 = try Some (inv_exp b' e2) with Deadcode -> None in
- (match m1, m2 with
- | Some m1, Some m2 -> CPA.meet m1 m2
- | Some m, None | None, Some m -> m
- | None, None -> raise Deadcode)
+ let st' = inv_exp a' e1 st in
+ let st'' = inv_exp b' e2 st' in
+ st''
(* | `Address a, `Address b -> ... *)
- | a1, a2 -> fallback ("binop: got abstract values that are not `Int: " ^ sprint VD.pretty a1 ^ " and " ^ sprint VD.pretty a2))
+ | a1, a2 -> fallback ("binop: got abstract values that are not `Int: " ^ sprint VD.pretty a1 ^ " and " ^ sprint VD.pretty a2) st)
| Lval x -> (* meet x with c *)
let t = Cil.unrollType (typeOfLval x) in (* unroll type to deal with TNamed *)
let c' = match t with
@@ -1524,17 +1487,17 @@ struct
| TEnum ({ekind = ik; _}, _) -> `Int (ID.cast_to ik c )
| _ -> `Int c
in
- let oldv = eval (Lval x) in
+ let oldv = eval (Lval x) st in
let v = VD.meet oldv c' in
if is_some_bot v then raise Deadcode
else (
if M.tracing then M.tracel "inv" "improve lval %a from %a to %a (c = %a, c' = %a)\n" d_lval x VD.pretty oldv VD.pretty v ID.pretty c VD.pretty c';
- set' x v
+ set' x v st
)
- | Const _ -> fst st (* nothing to do *)
+ | Const _ -> st (* nothing to do *)
| CastE ((TInt (ik, _)) as t, e)
| CastE ((TEnum ({ekind = ik; _ }, _)) as t, e) -> (* Can only meet the t part of an Lval in e with c (unless we meet with all overflow possibilities)! Since there is no good way to do this, we only continue if e has no values outside of t. *)
- (match eval e with
+ (match eval e st with
| `Int i ->
if ID.leq i (ID.cast_to ik i) then
match Cil.typeOf e with
@@ -1542,14 +1505,14 @@ struct
| TEnum ({ekind = ik_e; _ }, _) ->
let c' = ID.cast_to ik_e c in
if M.tracing then M.tracel "inv" "cast: %a from %a to %a: i = %a; cast c = %a to %a = %a\n" d_exp e d_ikind ik_e d_ikind ik ID.pretty i ID.pretty c d_ikind ik_e ID.pretty c';
- inv_exp c' e
- | x -> fallback ("CastE: e did evaluate to `Int, but the type did not match" ^ sprint d_type t)
+ inv_exp c' e st
+ | x -> fallback ("CastE: e did evaluate to `Int, but the type did not match" ^ sprint d_type t) st
else
- fallback ("CastE: " ^ sprint d_plainexp e ^ " evaluates to " ^ sprint ID.pretty i ^ " which is bigger than the type it is cast to which is " ^ sprint d_type t)
- | v -> fallback ("CastE: e did not evaluate to `Int, but " ^ sprint VD.pretty v))
- | e -> fallback (sprint d_plainexp e ^ " not implemented")
+ fallback ("CastE: " ^ sprint d_plainexp e ^ " evaluates to " ^ sprint ID.pretty i ^ " which is bigger than the type it is cast to which is " ^ sprint d_type t) st
+ | v -> fallback ("CastE: e did not evaluate to `Int, but " ^ sprint VD.pretty v) st)
+ | e -> fallback (sprint d_plainexp e ^ " not implemented") st
in
- if eval_bool exp = Some (not tv) then raise Deadcode (* we already know that the branch is dead *)
+ if eval_bool exp st = Some (not tv) then raise Deadcode (* we already know that the branch is dead *)
else
let is_cmp = function
| BinOp ((Lt | Gt | Le | Ge | Eq | Ne), _, _, t) -> true
@@ -1563,12 +1526,13 @@ struct
let ik = Cilfacade.get_ikind (typeOf exp) in
ID.of_excl_list ik [BI.zero] (* Lvals, Casts, arithmetic operations etc. should work with true = non_zero *)
in
- Tuple2.map1 (fun _ -> inv_exp itv exp) st
+ inv_exp itv exp st
- let set_savetop ?lval_raw ?rval_raw ask (gs:glob_fun) st adr lval_t v : store =
+ let set_savetop ?ctx ?lval_raw ?rval_raw ask (gs:glob_fun) st adr lval_t v : store =
+ if M.tracing then M.tracel "set" "savetop %a %a %a\n" AD.pretty adr d_type lval_t VD.pretty v;
match v with
- | `Top -> set ask gs st adr lval_t (VD.top_value (AD.get_type adr)) ?lval_raw ?rval_raw
- | v -> set ask gs st adr lval_t v ?lval_raw ?rval_raw
+ | `Top -> set ~ctx ask gs st adr lval_t (VD.top_value (AD.get_type adr)) ?lval_raw ?rval_raw
+ | v -> set ~ctx ask gs st adr lval_t v ?lval_raw ?rval_raw
(**************************************************************************
@@ -1621,7 +1585,7 @@ struct
in
match is_list_init () with
| Some a when (get_bool "exp.list-type") ->
- set ctx.ask ctx.global ctx.local (AD.singleton (Addr.from_var a)) lval_t (`List (ValueDomain.Lists.bot ()))
+ set ~ctx:(Some ctx) ctx.ask ctx.global ctx.local (AD.singleton (Addr.from_var a)) lval_t (`List (ValueDomain.Lists.bot ()))
| _ ->
let rval_val = eval_rv ctx.ask ctx.global ctx.local rval in
let lval_val = eval_lv ctx.ask ctx.global ctx.local lval in
@@ -1654,15 +1618,15 @@ struct
let t = v.vtype in
let iv = VD.bot_value t in (* correct bottom value for top level variable *)
let nv = VD.update_offset ctx.ask iv offs rval_val (Some (Lval lval)) lval t in (* do desired update to value *)
- set_savetop ctx.ask ctx.global ctx.local (AD.from_var v) lval_t nv (* set top-level variable to updated value *)
+ set_savetop ~ctx ctx.ask ctx.global ctx.local (AD.from_var v) lval_t nv (* set top-level variable to updated value *)
| _ ->
- set_savetop ctx.ask ctx.global ctx.local lval_val lval_t rval_val ~lval_raw:lval ~rval_raw:rval
+ set_savetop ~ctx ctx.ask ctx.global ctx.local lval_val lval_t rval_val ~lval_raw:lval ~rval_raw:rval
)
| _ ->
- set_savetop ctx.ask ctx.global ctx.local lval_val lval_t rval_val ~lval_raw:lval ~rval_raw:rval
+ set_savetop ~ctx ctx.ask ctx.global ctx.local lval_val lval_t rval_val ~lval_raw:lval ~rval_raw:rval
)
| _ ->
- set_savetop ctx.ask ctx.global ctx.local lval_val lval_t rval_val ~lval_raw:lval ~rval_raw:rval
+ set_savetop ~ctx ctx.ask ctx.global ctx.local lval_val lval_t rval_val ~lval_raw:lval ~rval_raw:rval
module Locmap = Deadcode.Locmap
@@ -1729,21 +1693,22 @@ struct
let init_var v = (AD.from_var v, v.vtype, VD.init_value v.vtype) in
(* Apply it to all the locals and then assign them all *)
let inits = List.map init_var f.slocals in
- set_many ctx.ask ctx.global ctx.local inits
+ set_many ~ctx ctx.ask ctx.global ctx.local inits
- let return ctx exp fundec =
- let (cp,dep) = ctx.local in
+ let return ctx exp fundec: store =
+ let st: store = ctx.local in
match fundec.svar.vname with
- | "__goblint_dummy_init" ->
- publish_all ctx;
- cp, dep
+ | "__goblint_dummy_init"
| "StartupHook" ->
- publish_all ctx;
- cp, dep
+ if M.tracing then M.trace "init" "dummy init: %a\n" D.pretty st;
+ publish_all ctx `Init;
+ (* otherfun uses __goblint_dummy_init, where we can properly side effect global initialization *)
+ (* TODO: move into sync `Init *)
+ Priv.enter_multithreaded ctx.ask ctx.global ctx.sideg st
| _ ->
let locals = (fundec.sformals @ fundec.slocals) in
let nst_part = rem_many_paritioning ctx.ask ctx.local locals in
- let nst = rem_many ctx.ask nst_part locals in
+ let nst: store = rem_many ctx.ask nst_part locals in
match exp with
| None -> nst
| Some exp ->
@@ -1753,12 +1718,12 @@ struct
| _ -> assert false
in
let rv = eval_rv ctx.ask ctx.global ctx.local exp in
- let nst =
+ let nst: store =
match ThreadId.get_current ctx.ask with
- | `Lifted tid when ThreadReturn.is_current ctx.ask -> Tuple2.map1 (CPA.add tid rv) nst
+ | `Lifted tid when ThreadReturn.is_current ctx.ask -> { nst with cpa = CPA.add tid rv nst.cpa}
| _ -> nst
in
- set ~t_override ctx.ask ctx.global nst (return_var ()) t_override rv
+ set ~ctx:(Some ctx) ~t_override ctx.ask ctx.global nst (return_var ()) t_override rv
(* lval_raw:None, and rval_raw:None is correct here *)
let vdecl ctx (v:varinfo) =
@@ -1768,13 +1733,14 @@ struct
let lval = eval_lv ctx.ask ctx.global ctx.local (Var v, NoOffset) in
let current_value = eval_rv ctx.ask ctx.global ctx.local (Lval (Var v, NoOffset)) in
let new_value = VD.update_array_lengths (eval_rv ctx.ask ctx.global ctx.local) current_value v.vtype in
- set ctx.ask ctx.global ctx.local lval v.vtype new_value
+ set ~ctx:(Some ctx) ctx.ask ctx.global ctx.local lval v.vtype new_value
(**************************************************************************
* Function calls
**************************************************************************)
- let invalidate ask (gs:glob_fun) (st:store) (exps: exp list): store =
+ let invalidate ?ctx ask (gs:glob_fun) (st:store) (exps: exp list): store =
if M.tracing && exps <> [] then M.tracel "invalidate" "Will invalidate expressions [%a]\n" (d_list ", " d_plainexp) exps;
+ M.warn_each ("Invalidating expressions: " ^ sprint (d_list ", " d_plainexp) exps);
(* To invalidate a single address, we create a pair with its corresponding
* top value. *)
let invalidate_address st a =
@@ -1796,9 +1762,8 @@ struct
in
(* We concatMap the previous function on the list of expressions. *)
let invalids = List.concat (List.map invalidate_exp exps) in
- let my_favorite_things = List.map Json.string !precious_globs in
let is_fav_addr x =
- List.exists (fun x -> List.mem x.vname my_favorite_things) (AD.to_var_may x)
+ List.exists BaseUtil.is_precious_glob (AD.to_var_may x)
in
let invalids' = List.filter (fun (x,_,_) -> not (is_fav_addr x)) invalids in
if M.tracing && exps <> [] then (
@@ -1806,7 +1771,7 @@ struct
let vs = List.map (Tuple3.third) invalids' in
M.tracel "invalidate" "Setting addresses [%a] to values [%a]\n" (d_list ", " AD.pretty) addrs (d_list ", " VD.pretty) vs
);
- set_many ask gs st invalids'
+ set_many ?ctx ask gs st invalids'
(* Variation of the above for yet another purpose, uhm, code reuse? *)
let collect_funargs ask (gs:glob_fun) (st:store) (exps: exp list) =
@@ -1823,22 +1788,37 @@ struct
List.concat (List.map do_exp exps)
- let make_entry (ctx:(D.t, G.t, C.t) Analyses.ctx) fn args: D.t =
- let (cpa,dep) as st = ctx.local in
+ let make_entry ?(thread=false) (ctx:(D.t, G.t, C.t) Analyses.ctx) fn args: D.t =
+ let st: store = ctx.local in
(* Evaluate the arguments. *)
let vals = List.map (eval_rv ctx.ask ctx.global st) args in
(* generate the entry states *)
let fundec = Cilfacade.getdec fn in
(* If we need the globals, add them *)
- let globals = CPA.filter (fun k v -> V.is_global k) cpa in
- let new_cpa = if !GU.earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in
+ (* TODO: make this is_private PrivParam dependent? PerMutexOplusPriv should keep *)
+ let st' =
+ if thread then (
+ (* TODO: HACK: Simulate enter_multithreaded for first entering thread to publish global inits before analyzing thread.
+ Otherwise thread is analyzed with no global inits, reading globals gives bot, which turns into top, which might get published...
+ sync `Thread doesn't help us here, it's not specific to entering multithreaded mode.
+ EnterMultithreaded events only execute after threadenter and threadspawn. *)
+ if not (ThreadFlag.is_multi ctx.ask) then
+ ignore (Priv.enter_multithreaded ctx.ask ctx.global ctx.sideg st);
+ Priv.threadenter ctx.ask st
+ ) else
+ let globals = CPA.filter (fun k v -> V.is_global k) st.cpa in
+ (* let new_cpa = if !GU.earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *)
+ let new_cpa = globals in
+ {st with cpa = new_cpa}
+ in
(* Assign parameters to arguments *)
let pa = zip fundec.sformals vals in
- let new_cpa = CPA.add_list pa new_cpa in
+ let new_cpa = CPA.add_list pa st'.cpa in
(* List of reachable variables *)
let reachable = List.concat (List.map AD.to_var_may (reachable_vars ctx.ask (get_ptrs vals) ctx.global st)) in
- let new_cpa = CPA.add_list_fun reachable (fun v -> CPA.find v cpa) new_cpa in
- new_cpa, dep
+ let reachable = List.filter (fun v -> CPA.mem v st.cpa) reachable in
+ let new_cpa = CPA.add_list_fun reachable (fun v -> CPA.find v st.cpa) new_cpa in
+ {st' with cpa = new_cpa}
let enter ctx lval fn args : (D.t * D.t) list =
[ctx.local, make_entry ctx fn args]
@@ -1870,12 +1850,13 @@ struct
(* handling thread creations *)
| `ThreadCreate (id,start,ptc_arg) -> begin
(* extra sync so that we do not analyze new threads with bottom global invariant *)
- publish_all ctx;
+ publish_all ctx `Thread;
(* Collect the threads. *)
let start_addr = eval_tv ctx.ask ctx.global ctx.local start in
List.filter_map (create_thread (Some (Mem id, NoOffset)) (Some ptc_arg)) (AD.to_var_may start_addr)
end
- | `Unknown _ when get_bool "exp.unknown_funs_spawn" -> begin
+ | `Unknown "free" -> []
+ | `Unknown _ when get_bool "sem.unknown_function.spawn" -> begin
let args =
match LF.get_invalidate_action f.vname with
| Some fnc -> fnc `Write args (* why do we only spawn arguments that are written?? *)
@@ -1883,6 +1864,7 @@ struct
in
let flist = collect_funargs ctx.ask ctx.global ctx.local args in
let addrs = List.concat (List.map AD.to_var_may flist) in
+ if addrs <> [] then M.warn_each ("Spawning functions from unknown function: " ^ sprint (d_list ", " d_varinfo) addrs);
List.filter_map (create_thread None None) addrs
end
| _ -> []
@@ -1941,7 +1923,7 @@ struct
let forks = forkfun ctx lv f args in
if M.tracing then if not (List.is_empty forks) then M.tracel "spawn" "Base.special %s: spawning functions %a\n" f.vname (d_list "," d_varinfo) (List.map BatTuple.Tuple3.second forks);
List.iter (BatTuple.Tuple3.uncurry ctx.spawn) forks;
- let cpa,dep as st = ctx.local in
+ let st: store = ctx.local in
let gs = ctx.global in
match LF.classify f.vname args with
| `Unknown "F59" (* strcpy *)
@@ -1986,10 +1968,10 @@ struct
let eadr = AD.singleton (Addr.from_var elm) in
let eitemadr = AD.singleton (Addr.from_var_offset (elm, convert_offset ctx.ask ctx.global ctx.local next)) in
let new_list = `List (ValueDomain.Lists.add eadr ld) in
- let s1 = set ctx.ask ctx.global ctx.local ladr lst.vtype new_list in
- let s2 = set ctx.ask ctx.global s1 eitemadr (AD.get_type eitemadr) (`Address (AD.singleton (Addr.from_var lst))) in
+ let s1 = set ~ctx:(Some ctx) ctx.ask ctx.global ctx.local ladr lst.vtype new_list in
+ let s2 = set ~ctx:(Some ctx) ctx.ask ctx.global s1 eitemadr (AD.get_type eitemadr) (`Address (AD.singleton (Addr.from_var lst))) in
s2
- | _ -> set ctx.ask ctx.global ctx.local ladr lst.vtype `Top
+ | _ -> set ~ctx:(Some ctx) ctx.ask ctx.global ctx.local ladr lst.vtype `Top
end
| _ -> M.bailwith "List function arguments are strange/complicated."
end
@@ -2001,13 +1983,13 @@ struct
let lptr = AD.singleton (Addr.from_var_offset (elm, convert_offset ctx.ask ctx.global ctx.local next)) in
let lprt_val = get ctx.ask ctx.global ctx.local lptr None in
let lst_poison = `Address (AD.singleton (Addr.from_var ListDomain.list_poison)) in
- let s1 = set ctx.ask ctx.global ctx.local lptr (AD.get_type lptr) (VD.join lprt_val lst_poison) in
+ let s1 = set ~ctx:(Some ctx) ctx.ask ctx.global ctx.local lptr (AD.get_type lptr) (VD.join lprt_val lst_poison) in
match get ctx.ask ctx.global ctx.local lptr None with
| `Address ladr -> begin
match get ctx.ask ctx.global ctx.local ladr None with
| `List ld ->
let del_ls = ValueDomain.Lists.del eadr ld in
- let s2 = set ctx.ask ctx.global s1 ladr (AD.get_type ladr) (`List del_ls) in
+ let s2 = set ~ctx:(Some ctx) ctx.ask ctx.global s1 ladr (AD.get_type ladr) (`List del_ls) in
s2
| _ -> s1
end
@@ -2023,13 +2005,16 @@ struct
end
| `Unknown "exit" -> raise Deadcode
| `Unknown "abort" -> raise Deadcode
+ | `Unknown "__builtin_unreachable" when get_bool "sem.builtin_unreachable.dead_code" -> raise Deadcode (* https://github.com/sosy-lab/sv-benchmarks/issues/1296 *)
| `Unknown "pthread_exit" ->
begin match args with
| [exp] ->
begin match ThreadId.get_current ctx.ask with
| `Lifted tid ->
let rv = eval_rv ctx.ask ctx.global ctx.local exp in
- ctx.sideg tid rv
+ let nst = {st with cpa=CPA.add tid rv st.cpa} in
+ (* TODO: emit thread return event so other analyses are aware? *)
+ publish_all {ctx with local=nst} `Return (* like normal return *)
| _ -> ()
end;
raise Deadcode
@@ -2047,19 +2032,19 @@ struct
end
(* handling thread creations *)
| `ThreadCreate _ ->
- D.bot () (* actual results joined via threadspawn *)
+ ctx.local (* actual results joined via threadspawn *)
(* handling thread joins... sort of *)
| `ThreadJoin (id,ret_var) ->
begin match (eval_rv ctx.ask gs st ret_var) with
- | `Int n when GU.opt_predicate (BI.equal BI.zero) (ID.to_int n) -> cpa,dep
+ | `Int n when GU.opt_predicate (BI.equal BI.zero) (ID.to_int n) -> st
| `Address ret_a ->
begin match eval_rv ctx.ask gs st id with
| `Address a ->
(* TODO: is this type right? *)
- set ctx.ask gs st ret_a (Cil.typeOf ret_var) (get ctx.ask gs st a None)
- | _ -> invalidate ctx.ask gs st [ret_var]
+ set ~ctx:(Some ctx) ctx.ask gs st ret_a (Cil.typeOf ret_var) (get ctx.ask gs st a None)
+ | _ -> invalidate ~ctx ctx.ask gs st [ret_var]
end
- | _ -> invalidate ctx.ask gs st [ret_var]
+ | _ -> invalidate ~ctx ctx.ask gs st [ret_var]
end
| `Malloc size -> begin
match lv with
@@ -2070,7 +2055,7 @@ struct
else AD.from_var (heap_var ctx)
in
(* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ctx.ask gs st size); *)
- set_many ctx.ask gs st [(heap_var, TVoid [], `Blob (VD.bot (), eval_int ctx.ask gs st size, true));
+ set_many ~ctx ctx.ask gs st [(heap_var, TVoid [], `Blob (VD.bot (), eval_int ctx.ask gs st size, true));
(eval_lv ctx.ask gs st lv, (Cil.typeOfLval lv), `Address heap_var)]
| _ -> st
end
@@ -2083,14 +2068,14 @@ struct
then AD.join addr AD.null_ptr (* calloc can fail and return NULL *)
else addr in
(* the memory that was allocated by calloc is set to bottom, but we keep track that it originated from calloc, so when bottom is read from memory allocated by calloc it is turned to zero *)
- set_many ctx.ask gs st [(add_null (AD.from_var heap_var), TVoid [], `Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.one) (`Blob (VD.bot (), eval_int ctx.ask gs st size, false))));
+ set_many ~ctx ctx.ask gs st [(add_null (AD.from_var heap_var), TVoid [], `Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.one) (`Blob (VD.bot (), eval_int ctx.ask gs st size, false))));
(eval_lv ctx.ask gs st lv, (Cil.typeOfLval lv), `Address (add_null (AD.from_var_offset (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset)))))]
| _ -> st
end
| `Unknown "__goblint_unknown" ->
begin match args with
| [Lval lv] | [CastE (_,AddrOf lv)] ->
- let st = set ctx.ask ctx.global ctx.local (eval_lv ctx.ask ctx.global st lv) (Cil.typeOfLval lv) `Top in
+ let st = set ~ctx:(Some ctx) ctx.ask ctx.global ctx.local (eval_lv ctx.ask ctx.global st lv) (Cil.typeOfLval lv) `Top in
st
| _ ->
M.bailwith "Function __goblint_unknown expected one address-of argument."
@@ -2104,17 +2089,27 @@ struct
| _ -> begin
let st =
match LF.get_invalidate_action f.vname with
- | Some fnc -> invalidate ctx.ask gs st (fnc `Write args)
+ | Some fnc -> invalidate ~ctx ctx.ask gs st (fnc `Write args)
| None -> (
(if f.vid <> dummyFunDec.svar.vid && not (LF.use_special f.vname) then M.warn_each ("Function definition missing for " ^ f.vname));
- let st_expr (v:varinfo) (value) a =
- if is_global ctx.ask v && not (is_static v) then
- mkAddrOf (Var v, NoOffset) :: a
- else a
+ (if f.vid = dummyFunDec.svar.vid then M.warn_each ("Unknown function ptr called"));
+ let addrs =
+ if get_bool "sem.unknown_function.invalidate.globals" then (
+ M.warn_each "INVALIDATING ALL GLOBALS!";
+ foldGlobals !Cilfacade.current_file (fun acc global ->
+ match global with
+ | GVar (vi, _, _) when not (is_static vi) ->
+ mkAddrOf (Var vi, NoOffset) :: acc
+ (* TODO: what about GVarDecl? *)
+ | _ -> acc
+ ) args
+ )
+ else
+ args
in
- let addrs = CPA.fold st_expr cpa args in
- (* invalidate arguments for unknown functions *)
- let (cpa,dep as st) = invalidate ctx.ask gs st addrs in
+ (* TODO: what about escaped local variables? *)
+ (* invalidate arguments and non-static globals for unknown functions *)
+ let st = invalidate ~ctx ctx.ask gs st addrs in
(*
* TODO: invalidate vars reachable via args
* publish globals
@@ -2129,77 +2124,105 @@ struct
| None -> st
| Some x ->
if M.tracing then M.tracel "invalidate" "Invalidating lhs %a for unknown function call %s\n" d_plainlval x f.vname;
- invalidate ctx.ask gs st [mkAddrOrStartOf x]
+ invalidate ~ctx ctx.ask gs st [mkAddrOrStartOf x]
in
(* apply all registered abstract effects from other analysis on the base value domain *)
- List.map (fun f -> f (fun lv -> (fun x -> set ctx.ask ctx.global st (eval_lv ctx.ask ctx.global st lv) (Cil.typeOfLval lv) x))) (LF.effects_for f.vname args) |> BatList.fold_left D.meet st
+ LF.effects_for f.vname args
+ |> List.map (fun sets ->
+ List.fold_left (fun acc (lv, x) ->
+ set ~ctx:(Some ctx) ctx.ask ctx.global acc (eval_lv ctx.ask ctx.global acc lv) (Cil.typeOfLval lv) x
+ ) st sets
+ )
+ |> BatList.fold_left D.meet st
+
+ (* List.map (fun f -> f (fun lv -> (fun x -> set ~ctx:(Some ctx) ctx.ask ctx.global st (eval_lv ctx.ask ctx.global st lv) (Cil.typeOfLval lv) x))) (LF.effects_for f.vname args) |> BatList.fold_left D.meet st *)
end
let combine ctx (lval: lval option) fexp (f: varinfo) (args: exp list) fc (after: D.t) : D.t =
- let combine_one (loc,ldep as st: D.t) ((fun_st,fun_dep) as fun_d: D.t) =
+ let combine_one (st: D.t) (fun_st: D.t) =
+ if M.tracing then M.tracel "combine" "%a\n%a\n" CPA.pretty st.cpa CPA.pretty fun_st.cpa;
(* This function does miscellaneous things, but the main task was to give the
* handle to the global state to the state return from the function, but now
* the function tries to add all the context variables back to the callee.
* Note that, the function return above has to remove all the local
* variables of the called function from cpa_s. *)
- let add_globals (cpa_s,dep_s) (cpa_d, dep_d) =
+ let add_globals (st: store) (fun_st: store) =
(* Remove the return value as this is dealt with separately. *)
- let cpa_s = CPA.remove (return_varinfo ()) cpa_s in
- let new_cpa = CPA.fold CPA.add cpa_s cpa_d in
- (new_cpa, dep_s)
+ let cpa_noreturn = CPA.remove (return_varinfo ()) fun_st.cpa in
+ let cpa_local = CPA.filter (fun x _ -> not (is_global ctx.ask x)) st.cpa in
+ let cpa' = CPA.fold CPA.add cpa_noreturn cpa_local in (* add cpa_noreturn to cpa_local *)
+ { fun_st with cpa = cpa' }
in
let return_var = return_var () in
let return_val =
- if CPA.mem (return_varinfo ()) fun_st
- then get ctx.ask ctx.global fun_d return_var None
+ if CPA.mem (return_varinfo ()) fun_st.cpa
+ then get ctx.ask ctx.global fun_st return_var None
else VD.top ()
in
- let st = add_globals (fun_st, fun_dep) st in
+ let st = add_globals st fun_st in
match lval with
| None -> st
- | Some lval -> set_savetop ctx.ask ctx.global st (eval_lv ctx.ask ctx.global st lval) (Cil.typeOfLval lval) return_val
+ | Some lval -> set_savetop ~ctx ctx.ask ctx.global st (eval_lv ctx.ask ctx.global st lval) (Cil.typeOfLval lval) return_val
in
combine_one ctx.local after
- let call_descr f (es,dep) =
+ let call_descr f (st: store) =
let short_fun x =
- match x.vtype, CPA.find x es with
+ match x.vtype, CPA.find x st.cpa with
| TPtr (t, attr), `Address a
when (not (AD.is_top a))
&& List.length (AD.to_var_may a) = 1
&& not (VD.is_immediate_type t)
->
let cv = List.hd (AD.to_var_may a) in
- "ref " ^ VD.short 26 (CPA.find cv es)
+ "ref " ^ VD.short 26 (CPA.find cv st.cpa)
| _, v -> VD.short 30 v
in
let args_short = List.map short_fun f.sformals in
Printable.get_short_list (GU.demangle f.svar.vname ^ "(") ")" 80 args_short
-
- let threadenter ctx (lval: lval option) (f: varinfo) (args: exp list): D.t =
+ let threadenter ctx (lval: lval option) (f: varinfo) (args: exp list): D.t list =
try
- make_entry ctx f args
+ [make_entry ~thread:true ctx f args]
with Not_found ->
(* Unknown functions *)
- ctx.local
+ [ctx.local]
let threadspawn ctx (lval: lval option) (f: varinfo) (args: exp list) fctx: D.t =
- match lval with
- | Some lval ->
- begin match ThreadId.get_current fctx.ask with
- | `Lifted tid ->
- (* TODO: is this type right? *)
- set ctx.ask ctx.global ctx.local (eval_lv ctx.ask ctx.global ctx.local lval) (Cil.typeOfLval lval) (`Address (AD.from_var tid))
- | _ ->
- ctx.local
- end
- | None ->
+ begin match lval with
+ | Some lval ->
+ begin match ThreadId.get_current fctx.ask with
+ | `Lifted tid ->
+ (* Cannot set here, because ctx isn't in multithreaded mode and set wouldn't side-effect if lval is global. *)
+ ctx.emit (Events.AssignSpawnedThread (lval, tid))
+ | _ -> ()
+ end
+ | None -> ()
+ end;
+ (* D.join ctx.local @@ *)
+ ctx.local
+
+ let event ctx e octx =
+ let st: store = ctx.local in
+ match e with
+ | Events.Lock addr when ThreadFlag.is_multi ctx.ask -> (* TODO: is this condition sound? *)
+ if M.tracing then M.tracel "priv" "LOCK EVENT %a\n" LockDomain.Addr.pretty addr;
+ Priv.lock octx.ask octx.global st addr
+ | Events.Unlock addr when ThreadFlag.is_multi ctx.ask -> (* TODO: is this condition sound? *)
+ Priv.unlock octx.ask octx.global octx.sideg st addr
+ | Events.Escape escaped ->
+ Priv.escape octx.ask octx.global octx.sideg st escaped
+ | Events.EnterMultiThreaded ->
+ Priv.enter_multithreaded octx.ask octx.global octx.sideg st
+ | Events.AssignSpawnedThread (lval, tid) ->
+ (* TODO: is this type right? *)
+ set ~ctx:(Some ctx) ctx.ask ctx.global ctx.local (eval_lv ctx.ask ctx.global ctx.local lval) (Cil.typeOfLval lval) (`Address (AD.from_var tid))
+ | _ ->
ctx.local
end
module type MainSpec = sig
- include Spec
+ include MCPSpec
include BaseDomain.ExpEvaluator
val return_lval: unit -> Cil.lval
val return_varinfo: unit -> Cil.varinfo
@@ -2207,8 +2230,26 @@ module type MainSpec = sig
val context_cpa: D.t -> BaseDomain.CPA.t
end
-module rec Main:MainSpec = MainFunctor(Main:BaseDomain.ExpEvaluator)
+let main_module: (module MainSpec) Lazy.t =
+ lazy (
+ let module Priv = (val BasePriv.get_priv ()) in
+ let module Main =
+ struct
+ (* Only way to locally define a recursive module. *)
+ module rec Main:MainSpec with type t = BaseComponents (Priv.D).t = MainFunctor (Priv) (Main)
+ include Main
+ end
+ in
+ (module Main)
+ )
-let _ =
+let get_main (): (module MainSpec) =
+ Lazy.force main_module
+
+let after_config () =
+ let module Main = (val get_main ()) in
(* add ~dep:["expRelation"] after modifying test cases accordingly *)
- MCP.register_analysis ~dep:["mallocWrapper"] (module Main : Spec)
+ MCP.register_analysis ~dep:["mallocWrapper"] (module Main : MCPSpec)
+
+let _ =
+ AfterConfig.register after_config
\ No newline at end of file
diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml
new file mode 100644
index 0000000000..392f98bbc5
--- /dev/null
+++ b/src/analyses/basePriv.ml
@@ -0,0 +1,1672 @@
+open Prelude.Ana
+open Analyses
+open GobConfig
+open BaseUtil
+module Q = Queries
+
+module IdxDom = ValueDomain.IndexDomain
+
+module VD = BaseDomain.VD
+module CPA = BaseDomain.CPA
+module BaseComponents = BaseDomain.BaseComponents
+
+
+module type S =
+sig
+ module D: Lattice.S
+ module G: Lattice.S
+
+ val startstate: unit -> D.t
+
+ val read_global: Q.ask -> (varinfo -> G.t) -> BaseComponents (D).t -> varinfo -> VD.t
+
+ (* [invariant]: Check if we should avoid producing a side-effect, such as updates to
+ * the state when following conditional guards. *)
+ val write_global: ?invariant:bool -> Q.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseComponents (D).t -> varinfo -> VD.t -> BaseComponents (D).t
+
+ val lock: Q.ask -> (varinfo -> G.t) -> BaseComponents (D).t -> LockDomain.Addr.t -> BaseComponents (D).t
+ val unlock: Q.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseComponents (D).t -> LockDomain.Addr.t -> BaseComponents (D).t
+
+ val sync: Q.ask -> (varinfo -> G.t) -> BaseComponents (D).t -> [`Normal | `Join | `Return | `Init | `Thread] -> BaseComponents (D).t * (varinfo * G.t) list
+
+ val escape: Q.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseComponents (D).t -> EscapeDomain.EscapedVars.t -> BaseComponents (D).t
+ val enter_multithreaded: Q.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseComponents (D).t -> BaseComponents (D).t
+ val threadenter: Q.ask -> BaseComponents (D).t -> BaseComponents (D).t
+
+ val init: unit -> unit
+ val finalize: unit -> unit
+end
+
+module NoInitFinalize =
+struct
+ let init () = ()
+ let finalize () = ()
+end
+
+let old_threadenter (type d) ask (st: d BaseDomain.basecomponents_t) =
+ (* Copy-paste from Base make_entry *)
+ let globals = CPA.filter (fun k v -> Basetype.Variables.is_global k) st.cpa in
+ (* let new_cpa = if !GU.earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *)
+ let new_cpa = globals in
+ {st with cpa = new_cpa}
+
+let startstate_threadenter (type d) (startstate: unit -> d) ask (st: d BaseDomain.basecomponents_t) =
+ {st with cpa = CPA.bot (); priv = startstate ()}
+
+module OldPrivBase =
+struct
+ include NoInitFinalize
+ module D = Lattice.Unit
+
+ let startstate () = ()
+
+ let lock ask getg st m = st
+ let unlock ask getg sideg st m = st
+
+ let escape ask getg sideg st escaped = st
+ let enter_multithreaded ask getg sideg st = st
+ let threadenter = old_threadenter
+
+ let sync_privates reason ask =
+ match reason with
+ | `Init
+ | `Thread ->
+ true
+ | _ ->
+ !GU.earlyglobs && not (ThreadFlag.is_multi ask)
+end
+
+(* Copy of ProtectionBasedOldPriv with is_private constantly false. *)
+module NonePriv: S =
+struct
+ include OldPrivBase
+
+ module G = BaseDomain.VD
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ getg x
+
+ let is_private (a: Q.ask) (v: varinfo): bool = false
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ if invariant && not (is_private ask x) then (
+ if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant);
+ st
+ )
+ else (
+ (* Here, an effect should be generated, but we add it to the local
+ * state, waiting for the sync function to publish it. *)
+ (* Copied from MainFunctor.update_variable *)
+ if ((get_bool "exp.volatiles_are_top") && (is_always_unknown x)) then
+ {st with cpa = CPA.add x (VD.top ()) st.cpa}
+ else
+ {st with cpa = CPA.add x v st.cpa}
+ )
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ (* For each global variable, we create the diff *)
+ let add_var (v: varinfo) (value) ((st: BaseComponents (D).t),acc) =
+ if M.tracing then M.traceli "globalize" ~var:v.vname "Tracing for %s\n" v.vname;
+ let res =
+ if is_global ask v then begin
+ if M.tracing then M.tracec "globalize" "Publishing its value: %a\n" VD.pretty value;
+ ({st with cpa = CPA.remove v st.cpa}, (v,value) :: acc)
+ end else
+ (st,acc)
+ in
+ if M.tracing then M.traceu "globalize" "Done!\n";
+ res
+ in
+ (* We fold over the local state, and collect the globals *)
+ CPA.fold add_var st.cpa (st, [])
+end
+
+(** Protection-Based Reading old implementation.
+ Unsound!
+ Based on [sync].
+ Works for OSEK. *)
+module ProtectionBasedOldPriv: S =
+struct
+ include OldPrivBase
+
+ module G = BaseDomain.VD
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ match CPA.find x st.cpa with
+ | `Bot -> (if M.tracing then M.tracec "get" "Using global invariant.\n"; getg x)
+ | x -> (if M.tracing then M.tracec "get" "Using privatized version.\n"; x)
+
+ let is_private (a: Q.ask) (v: varinfo): bool =
+ not (ThreadFlag.is_multi a) && is_precious_glob v (* not multi, but precious (earlyglobs) *)
+ || match a (Q.MayBePublic {global=v; write=false}) with `MayBool tv -> not tv | _ -> false (* usual case where MayBePublic answers *)
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ if invariant && not (is_private ask x) then (
+ if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant);
+ st
+ )
+ else (
+ (* Here, an effect should be generated, but we add it to the local
+ * state, waiting for the sync function to publish it. *)
+ (* Copied from MainFunctor.update_variable *)
+ if ((get_bool "exp.volatiles_are_top") && (is_always_unknown x)) then
+ {st with cpa = CPA.add x (VD.top ()) st.cpa}
+ else
+ {st with cpa = CPA.add x v st.cpa}
+ )
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ let privates = sync_privates reason ask in
+ let module BaseComponents = BaseComponents (D) in
+ if M.tracing then M.tracel "sync" "OldPriv: %a\n" BaseComponents.pretty st;
+ (* For each global variable, we create the diff *)
+ let add_var (v: varinfo) (value) ((st: BaseComponents.t),acc) =
+ if M.tracing then M.traceli "globalize" ~var:v.vname "Tracing for %s\n" v.vname;
+ let res =
+ if is_global ask v && ((privates && not (is_precious_glob v)) || not (is_private ask v)) then begin
+ if M.tracing then M.tracec "globalize" "Publishing its value: %a\n" VD.pretty value;
+ ({st with cpa = CPA.remove v st.cpa}, (v,value) :: acc)
+ end else
+ (st,acc)
+ in
+ if M.tracing then M.traceu "globalize" "Done!\n";
+ res
+ in
+ (* We fold over the local state, and collect the globals *)
+ CPA.fold add_var st.cpa (st, [])
+end
+
+module Protection =
+struct
+ let is_unprotected ask x: bool =
+ let multi = ThreadFlag.is_multi ask in
+ (!GU.earlyglobs && not multi && not (is_precious_glob x)) ||
+ (
+ multi &&
+ match ask (Q.MayBePublic {global=x; write=true}) with
+ | `MayBool x -> x
+ | `Top -> true
+ | _ -> failwith "Protection.is_unprotected"
+ )
+
+ let is_unprotected_without ask ?(write=true) x m: bool =
+ ThreadFlag.is_multi ask &&
+ match ask (Q.MayBePublicWithout {global=x; write; without_mutex=m}) with
+ | `MayBool x -> x
+ | `Top -> true
+ | _ -> failwith "Protection.is_unprotected_without"
+
+ let is_protected_by ask m x: bool =
+ is_global ask x &&
+ not (VD.is_immediate_type x.vtype) &&
+ match ask (Q.MustBeProtectedBy {mutex=m; global=x; write=true}) with
+ | `MustBool x -> x
+ | `Top -> false
+ | _ -> failwith "Protection.is_protected_by"
+
+ let is_atomic ask: bool =
+ match ask Q.MustBeAtomic with
+ | `MustBool x -> x
+ | `Top -> false
+ | _ -> failwith "Protection.is_atomic"
+end
+
+module MutexGlobalsBase =
+struct
+ let mutex_addr_to_varinfo = function
+ | LockDomain.Addr.Addr (v, `NoOffset) -> v
+ | LockDomain.Addr.Addr (v, offs) ->
+ M.warn_each (Pretty.sprint ~width:800 @@ Pretty.dprintf "MutexGlobalsBase: ignoring offset %a%a" d_varinfo v LockDomain.Addr.Offs.pretty offs);
+ v
+ | _ -> failwith "MutexGlobalsBase.mutex_addr_to_varinfo"
+end
+
+module ImplicitMutexGlobals =
+struct
+ include MutexGlobalsBase
+ let mutex_global x = x
+end
+
+module ExplicitMutexGlobals =
+struct
+ include MutexGlobalsBase
+ let mutex_global = RichVarinfo.Variables.map ~name:(fun x -> "MUTEX_GLOBAL_" ^ x.vname)
+ let mutex_global x =
+ let r = mutex_global x in
+ if M.tracing then M.tracel "priv" "mutex_global %a = %a\n" d_varinfo x d_varinfo r;
+ r
+end
+
+module PerMutexPrivBase =
+struct
+ include NoInitFinalize
+ include ExplicitMutexGlobals
+ include Protection
+
+ module D = Lattice.Unit
+ module G = CPA
+
+ let startstate () = ()
+
+ let mutex_inits = RichVarinfo.single ~name:"MUTEX_INITS"
+
+ let get_m_with_mutex_inits ask getg m =
+ let get_m = getg (mutex_addr_to_varinfo m) in
+ let get_mutex_inits = getg (mutex_inits ()) in
+ let is_in_Gm x _ = is_protected_by ask m x in
+ let get_mutex_inits' = CPA.filter is_in_Gm get_mutex_inits in
+ if M.tracing then M.tracel "priv" "get_m_with_mutex_inits %a:\n get_m: %a\n get_mutex_inits: %a\n get_mutex_inits': %a\n" LockDomain.Addr.pretty m CPA.pretty get_m CPA.pretty get_mutex_inits CPA.pretty get_mutex_inits';
+ CPA.join get_m get_mutex_inits'
+
+ (** [get_m_with_mutex_inits] optimized for implementation-specialized [read_global]. *)
+ let get_mutex_global_x_with_mutex_inits getg x =
+ let get_mutex_global_x = getg (mutex_global x) in
+ let get_mutex_inits = getg (mutex_inits ()) in
+ match CPA.find_opt x get_mutex_global_x, CPA.find_opt x get_mutex_inits with
+ | Some v1, Some v2 -> Some (VD.join v1 v2)
+ | Some v, None
+ | None, Some v -> Some v
+ | None, None -> None
+
+ let escape ask getg sideg (st: BaseComponents (D).t) escaped =
+ let escaped_cpa = CPA.filter (fun x _ -> EscapeDomain.EscapedVars.mem x escaped) st.cpa in
+ sideg (mutex_inits ()) escaped_cpa;
+
+ let cpa' = CPA.fold (fun x v acc ->
+ if EscapeDomain.EscapedVars.mem x escaped (* && is_unprotected ask x *) then (
+ if M.tracing then M.tracel "priv" "ESCAPE SIDE %a = %a\n" d_varinfo x VD.pretty v;
+ sideg (mutex_global x) (CPA.add x v (CPA.bot ()));
+ CPA.remove x acc
+ )
+ else
+ acc
+ ) st.cpa st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) =
+ let global_cpa = CPA.filter (fun x _ -> is_global ask x) st.cpa in
+ sideg (mutex_inits ()) global_cpa;
+
+ let cpa' = CPA.fold (fun x v acc ->
+ if is_global ask x (* && is_unprotected ask x *) then (
+ if M.tracing then M.tracel "priv" "enter_multithreaded remove %a\n" d_varinfo x;
+ if M.tracing then M.tracel "priv" "ENTER MULTITHREADED SIDE %a = %a\n" d_varinfo x VD.pretty v;
+ sideg (mutex_global x) (CPA.add x v (CPA.bot ()));
+ CPA.remove x acc
+ )
+ else
+ acc
+ ) st.cpa st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let threadenter = old_threadenter
+end
+
+module PerMutexOplusPriv: S =
+struct
+ include PerMutexPrivBase
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ if is_unprotected ask x then
+ let get_mutex_global_x = get_mutex_global_x_with_mutex_inits getg x in
+ get_mutex_global_x |? VD.bot ()
+ else
+ CPA.find x st.cpa
+ (* let read_global ask getg cpa x =
+ let (cpa', v) as r = read_global ask getg cpa x in
+ ignore (Pretty.printf "READ GLOBAL %a (%a, %B) = %a\n" d_varinfo x d_loc !Tracing.current_loc (is_unprotected ask x) VD.pretty v);
+ r *)
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let cpa' = CPA.add x v st.cpa in
+ sideg (mutex_global x) (CPA.add x v (CPA.bot ()));
+ {st with cpa = cpa'}
+ (* let write_global ask getg sideg cpa x v =
+ let cpa' = write_global ask getg sideg cpa x v in
+ ignore (Pretty.printf "WRITE GLOBAL %a %a = %a\n" d_varinfo x VD.pretty v CPA.pretty cpa');
+ cpa' *)
+
+ let lock ask getg (st: BaseComponents (D).t) m =
+ let get_m = get_m_with_mutex_inits ask getg m in
+ let is_in_V x _ = is_protected_by ask m x && is_unprotected ask x in
+ let cpa' = CPA.filter is_in_V get_m in
+ if M.tracing then M.tracel "priv" "PerMutexOplusPriv.lock m=%a cpa'=%a\n" LockDomain.Addr.pretty m CPA.pretty cpa';
+ {st with cpa = CPA.fold CPA.add cpa' st.cpa}
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let is_in_Gm x _ = is_protected_by ask m x in
+ let side_m_cpa = CPA.filter is_in_Gm st.cpa in
+ if M.tracing then M.tracel "priv" "PerMutexOplusPriv.unlock m=%a side_m_cpa=%a\n" LockDomain.Addr.pretty m CPA.pretty side_m_cpa;
+ sideg (mutex_addr_to_varinfo m) side_m_cpa;
+ st
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Join -> (* required for branched thread creation *)
+ let sidegs = CPA.fold (fun x v acc ->
+ (* TODO: is_unprotected - why breaks 02/11 init_mainfun? *)
+ if is_global ask x && is_unprotected ask x then
+ (mutex_global x, CPA.add x v (CPA.bot ())) :: acc
+ else
+ acc
+ ) st.cpa []
+ in
+ (st, sidegs)
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, CPA.add x v (CPA.bot ()))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Init
+ | `Thread ->
+ (st, [])
+end
+
+module PerMutexMeetPriv: S =
+struct
+ include PerMutexPrivBase
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ if is_unprotected ask x then (
+ let get_mutex_global_x = get_mutex_global_x_with_mutex_inits getg x in
+ (* None is VD.top () *)
+ match CPA.find_opt x st.cpa, get_mutex_global_x with
+ | Some v1, Some v2 -> VD.meet v1 v2
+ | Some v, None
+ | None, Some v -> v
+ | None, None -> VD.bot () (* Except if both None, needed for 09/07 kernel_list_rc *)
+ (* get_mutex_global_x |? VD.bot () *)
+ )
+ else
+ CPA.find x st.cpa
+ let read_global ask getg st x =
+ let v = read_global ask getg st x in
+ if M.tracing then M.tracel "priv" "READ GLOBAL %a %B %a = %a\n" d_varinfo x (is_unprotected ask x) CPA.pretty st.cpa VD.pretty v;
+ v
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let cpa' =
+ if is_unprotected ask x then
+ st.cpa
+ else
+ CPA.add x v st.cpa
+ in
+ if M.tracing then M.tracel "priv" "WRITE GLOBAL SIDE %a = %a\n" d_varinfo x VD.pretty v;
+ sideg (mutex_global x) (CPA.add x v (CPA.bot ()));
+ {st with cpa = cpa'}
+ (* let write_global ask getg sideg cpa x v =
+ let cpa' = write_global ask getg sideg cpa x v in
+ ignore (Pretty.printf "WRITE GLOBAL %a %a = %a\n" d_varinfo x VD.pretty v CPA.pretty cpa');
+ cpa' *)
+
+ let lock ask getg (st: BaseComponents (D).t) m =
+ let get_m = get_m_with_mutex_inits ask getg m in
+ (* Additionally filter get_m in case it contains variables it no longer protects. *)
+ let is_in_Gm x _ = is_protected_by ask m x in
+ let get_m = CPA.filter is_in_Gm get_m in
+ let long_meet m1 m2 = CPA.long_map2 VD.meet m1 m2 in
+ let meet = long_meet st.cpa get_m in
+ if M.tracing then M.tracel "priv" "LOCK %a:\n get_m: %a\n meet: %a\n" LockDomain.Addr.pretty m CPA.pretty get_m CPA.pretty meet;
+ {st with cpa = meet}
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let is_in_Gm x _ = is_protected_by ask m x in
+ sideg (mutex_addr_to_varinfo m) (CPA.filter is_in_Gm st.cpa);
+ let cpa' = CPA.fold (fun x v cpa ->
+ if is_protected_by ask m x && is_unprotected_without ask x m then
+ CPA.remove x cpa
+ (* CPA.add x (VD.top ()) cpa *)
+ else
+ cpa
+ ) st.cpa st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Join -> (* required for branched thread creation *)
+ let (cpa', sidegs') = CPA.fold (fun x v ((cpa, sidegs) as acc) ->
+ if is_global ask x && is_unprotected ask x (* && not (VD.is_top v) *) then (
+ if M.tracing then M.tracel "priv" "SYNC SIDE %a = %a\n" d_varinfo x VD.pretty v;
+ (CPA.remove x cpa, (mutex_global x, CPA.add x v (CPA.bot ())) :: sidegs)
+ )
+ else (
+ if M.tracing then M.tracel "priv" "SYNC NOSIDE %a = %a\n" d_varinfo x VD.pretty v;
+ acc
+ )
+ ) st.cpa (st.cpa, [])
+ in
+ ({st with cpa = cpa'}, sidegs')
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, CPA.add x v (CPA.bot ()))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Init
+ | `Thread ->
+ (st, [])
+end
+
+module MustVars =
+struct
+ module MayVars = SetDomain.ToppedSet (Basetype.Variables) (struct let topname = "All Variables" end)
+ include SetDomain.Reverse (MayVars)
+ let name () = "must variables"
+end
+
+(** Protection-Based Reading early implementation for traces paper by Vesal.
+ Based on [sync].
+ Works for OSEK. *)
+module ProtectionBasedVesalPriv: S =
+struct
+ include OldPrivBase
+
+ module D = MustVars
+ module G = BaseDomain.VD
+
+ let startstate () = D.top ()
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ match CPA.find x st.cpa with
+ | `Bot -> (if M.tracing then M.tracec "get" "Using global invariant.\n"; getg x)
+ | x -> (if M.tracing then M.tracec "get" "Using privatized version.\n"; x)
+
+ let is_invisible (a: Q.ask) (v: varinfo): bool =
+ not (ThreadFlag.is_multi a) && is_precious_glob v (* not multi, but precious (earlyglobs) *)
+ || match a (Q.MayBePublic {global=v; write=false}) with `MayBool tv -> not tv | _ -> false (* usual case where MayBePublic answers *)
+ let is_private = is_invisible
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ if invariant && not (is_private ask x) then (
+ if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant);
+ st
+ )
+ else (
+ (* Here, an effect should be generated, but we add it to the local
+ * state, waiting for the sync function to publish it. *)
+ (* Copied from MainFunctor.update_variable *)
+ if ((get_bool "exp.volatiles_are_top") && (is_always_unknown x)) then
+ {st with cpa = CPA.add x (VD.top ()) st.cpa; priv = MustVars.add x st.priv}
+ else
+ {st with cpa = CPA.add x v st.cpa; priv = MustVars.add x st.priv}
+ )
+
+ let is_protected (a: Q.ask) (v: varinfo): bool =
+ not (ThreadFlag.is_multi a) && is_precious_glob v (* not multi, but precious (earlyglobs) *)
+ || match a (Q.MayBePublic {global=v; write=true}) with `MayBool tv -> not tv | _ -> false (* usual case where MayBePublic answers *)
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ let privates = sync_privates reason ask in
+ (* For each global variable, we create the diff *)
+ let add_var (v: varinfo) (value) ((st: BaseComponents (D).t),acc) =
+ if M.tracing then M.traceli "globalize" ~var:v.vname "Tracing for %s\n" v.vname;
+ let res =
+ if is_global ask v then
+ let protected = is_protected ask v in
+ if privates && not (is_precious_glob v) || not protected then begin
+ if M.tracing then M.tracec "globalize" "Publishing its value: %a\n" VD.pretty value;
+ ({ st with cpa = CPA.remove v st.cpa; priv = MustVars.remove v st.priv} , (v,value) :: acc)
+ end else (* protected == true *)
+ let (st, acc) = if not (MustVars.mem v st.priv) then
+ let joined = VD.join (CPA.find v st.cpa) (getg v) in
+ ( {st with cpa = CPA.add v joined st.cpa} ,acc)
+ else (st,acc)
+ in
+ let invisible = is_invisible ask v in
+ if not invisible then (st, (v,value) :: acc) else (st,acc)
+ else (st,acc)
+ in
+ if M.tracing then M.traceu "globalize" "Done!\n";
+ res
+ in
+ (* We fold over the local state, and collect the globals *)
+ CPA.fold add_var st.cpa (st, [])
+
+ let threadenter = old_threadenter
+end
+
+module type PerGlobalPrivParam =
+sig
+ (** Whether to also check unprotectedness by reads for extra precision. *)
+ val check_read_unprotected: bool
+end
+
+(** Protection-Based Reading. *)
+module ProtectionBasedPriv (Param: PerGlobalPrivParam): S =
+struct
+ include NoInitFinalize
+ open Protection
+
+ module P =
+ struct
+ include MustVars
+ let name () = "P"
+ end
+ (* W is implicitly represented by CPA domain *)
+ module D = P
+
+ module GUnprot =
+ struct
+ include VD
+ let name () = "unprotected"
+ end
+ module GProt =
+ struct
+ include VD
+ let name () = "protected"
+ end
+ module G =
+ struct
+ include Lattice.Prod (GUnprot) (GProt) (* [g]', [g] *)
+
+ let unprotected = fst
+ let protected = snd
+ let create_unprotected v = (v, GProt.bot ())
+ let create_protected v = (GUnprot.bot (), v)
+ let create_init v = (v, v)
+ end
+
+ let startstate () = P.empty ()
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ if P.mem x st.priv then
+ CPA.find x st.cpa
+ else if is_unprotected ask x then
+ G.unprotected (getg x) (* CPA unnecessary because all values in GUnprot anyway *)
+ else
+ VD.join (CPA.find x st.cpa) (G.protected (getg x))
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ sideg x (if !GU.earlyglobs then G.create_init v else G.create_unprotected v); (* earlyglobs workaround for 13/60 *)
+ if is_unprotected ask x then
+ st
+ else
+ {st with cpa = CPA.add x v st.cpa; priv = P.add x st.priv}
+
+ let lock ask getg st m = st
+
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ (* TODO: what about G_m globals in cpa that weren't actually written? *)
+ CPA.fold (fun x v (st: BaseComponents (D).t) ->
+ if is_protected_by ask m x then ( (* is_in_Gm *)
+ (* Extra precision in implementation to pass tests:
+ If global is read-protected by multiple locks,
+ then inner unlock shouldn't yet publish. *)
+ if not Param.check_read_unprotected || is_unprotected_without ask ~write:false x m then
+ sideg x (G.create_protected v);
+
+ if is_unprotected_without ask x m then (* is_in_V' *)
+ {st with cpa = CPA.remove x st.cpa; priv = P.remove x st.priv}
+ else
+ st
+ )
+ else
+ st
+ ) st.cpa st
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Join -> (* required for branched thread creation *)
+ let (st', sidegs) =
+ CPA.fold (fun x v (((st: BaseComponents (D).t), sidegs) as acc) ->
+ if is_global ask x && is_unprotected ask x then
+ ({st with cpa = CPA.remove x st.cpa; priv = P.remove x st.priv}, (x, G.create_unprotected v) :: sidegs)
+ else
+ acc
+ ) st.cpa (st, [])
+ in
+ (st', sidegs)
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa; priv = P.remove x st.priv}, [(x, G.create_unprotected v)])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Init
+ | `Thread ->
+ (st, [])
+
+ let escape ask getg sideg (st: BaseComponents (D).t) escaped =
+ let cpa' = CPA.fold (fun x v acc ->
+ if EscapeDomain.EscapedVars.mem x escaped then (
+ sideg x (G.create_init v);
+ CPA.remove x acc
+ )
+ else
+ acc
+ ) st.cpa st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) =
+ CPA.fold (fun x v (st: BaseComponents (D).t) ->
+ if is_global ask x then (
+ sideg x (G.create_init v);
+ {st with cpa = CPA.remove x st.cpa; priv = P.remove x st.priv}
+ )
+ else
+ st
+ ) st.cpa st
+
+ let threadenter = startstate_threadenter startstate
+end
+
+module Locksets =
+struct
+ module Lock = LockDomain.Addr
+
+ module Lockset =
+ struct
+ include SetDomain.ToppedSet (Lock) (struct let topname = "All locks" end)
+ let disjoint s t = is_empty (inter s t)
+ end
+
+ let rec conv_offset = function
+ | `NoOffset -> `NoOffset
+ | `Field (f, o) -> `Field (f, conv_offset o)
+ (* TODO: better indices handling *)
+ | `Index (_, o) -> `Index (IdxDom.top (), conv_offset o)
+
+ let current_lockset (ask: Q.ask): Lockset.t =
+ (* TODO: remove this global_init workaround *)
+ if !GU.global_initialization then
+ Lockset.empty ()
+ else
+ match ask Queries.CurrentLockset with
+ | `LvalSet ls ->
+ Q.LS.fold (fun (var, offs) acc ->
+ Lockset.add (Lock.from_var_offset (var, conv_offset offs)) acc
+ ) ls (Lockset.empty ())
+ | _ -> failwith "Locksets.current_lockset"
+
+ (* TODO: reversed SetDomain.Hoare *)
+ module MinLocksets = SetDomain.Hoare (Lattice.Reverse (Lockset)) (struct let topname = "All locksets" end) (* reverse Lockset because Hoare keeps maximal, but we need minimal *)
+end
+
+module AbstractLockCenteredGBase (WeakRange: Lattice.S) (SyncRange: Lattice.S) =
+struct
+ open Locksets
+
+ module GWeak =
+ struct
+ include MapDomain.MapBot (Lockset) (WeakRange)
+ let name () = "weak"
+ end
+ module GSync =
+ struct
+ include MapDomain.MapBot (Lockset) (SyncRange)
+ let name () = "synchronized"
+ end
+ module G =
+ struct
+ (* weak: G -> (2^M -> WeakRange) *)
+ (* sync: M -> (2^M -> SyncRange) *)
+ include Lattice.Prod (GWeak) (GSync)
+
+ let weak = fst
+ let sync = snd
+ let create_weak weak = (weak, GSync.bot ())
+ let create_sync sync = (GWeak.bot (), sync)
+ end
+end
+
+module LockCenteredGBase =
+struct
+ (* weak: G -> (2^M -> D) *)
+ (* sync: M -> (2^M -> (G -> D)) *)
+ include AbstractLockCenteredGBase (VD) (CPA)
+end
+
+module MinePrivBase =
+struct
+ include NoInitFinalize
+ include ImplicitMutexGlobals (* explicit not needed here because G is Prod anyway? *)
+end
+
+module MineNaivePrivBase =
+struct
+ include MinePrivBase
+
+ module D = Lattice.Unit
+
+ let startstate () = ()
+ let escape ask getg sideg st escaped = st
+ let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) = st
+ let threadenter = old_threadenter
+end
+
+module MinePriv: S =
+struct
+ include MineNaivePrivBase
+ open Locksets
+
+ module Thread = ConcDomain.Thread
+ module ThreadMap = MapDomain.MapBot (Thread) (VD)
+
+ (* weak: G -> (2^M -> (T -> D)) *)
+ (* sync: M -> (2^M -> (G -> D)) *)
+ include AbstractLockCenteredGBase (ThreadMap) (CPA)
+
+ let global_init_thread = RichVarinfo.single ~name:"global_init"
+ let current_thread (ask: Q.ask): Thread.t =
+ if !GU.global_initialization then
+ global_init_thread ()
+ else
+ ThreadId.get_current_unlift ask
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ let s = current_lockset ask in
+ GWeak.fold (fun s' tm acc ->
+ if Lockset.disjoint s s' then
+ ThreadMap.fold (fun t' v acc ->
+ VD.join v acc
+ ) tm acc
+ else
+ acc
+ ) (fst (getg (mutex_global x))) (CPA.find x st.cpa)
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let s = current_lockset ask in
+ let t = current_thread ask in
+ let cpa' = CPA.add x v st.cpa in
+ if not (!GU.earlyglobs && is_precious_glob x) then
+ sideg (mutex_global x) (GWeak.add s (ThreadMap.add t v (ThreadMap.bot ())) (GWeak.bot ()), GSync.bot ());
+ {st with cpa = cpa'}
+
+ let lock ask getg (st: BaseComponents (D).t) m =
+ let s = current_lockset ask in
+ let cpa' = GSync.fold (fun s' cpa' acc ->
+ if Lockset.disjoint s s' then
+ CPA.join cpa' acc
+ else
+ acc
+ ) (snd (getg (mutex_addr_to_varinfo m))) st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let s = Lockset.remove m (current_lockset ask) in
+ let t = current_thread ask in
+ let side_cpa = CPA.filter (fun x _ ->
+ GWeak.fold (fun s' tm acc ->
+ (* TODO: swap 2^M and T partitioning for lookup by t here first? *)
+ let v = ThreadMap.find t tm in
+ (Lockset.mem m s' && not (VD.is_bot v)) || acc
+ ) (fst (getg (mutex_global x))) false
+ ) st.cpa
+ in
+ sideg (mutex_addr_to_varinfo m) (GWeak.bot (), GSync.add s side_cpa (GSync.bot ()));
+ st
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, (GWeak.add (Lockset.empty ()) (ThreadMap.add x v (ThreadMap.bot ())) (GWeak.bot ()), GSync.bot ()))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Join (* TODO: no problem with branched thread creation here? *)
+ | `Init
+ | `Thread ->
+ (st, [])
+end
+
+module MineNoThreadPriv: S =
+struct
+ include MineNaivePrivBase
+ include LockCenteredGBase
+ open Locksets
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ let s = current_lockset ask in
+ GWeak.fold (fun s' v acc ->
+ if Lockset.disjoint s s' then
+ VD.join v acc
+ else
+ acc
+ ) (fst (getg (mutex_global x))) (CPA.find x st.cpa)
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let s = current_lockset ask in
+ let cpa' = CPA.add x v st.cpa in
+ if not (!GU.earlyglobs && is_precious_glob x) then
+ sideg (mutex_global x) (GWeak.add s v (GWeak.bot ()), GSync.bot ());
+ {st with cpa = cpa'}
+
+ let lock ask getg (st: BaseComponents (D).t) m =
+ let s = current_lockset ask in
+ let cpa' = GSync.fold (fun s' cpa' acc ->
+ if Lockset.disjoint s s' then
+ CPA.join cpa' acc
+ else
+ acc
+ ) (snd (getg (mutex_addr_to_varinfo m))) st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let s = Lockset.remove m (current_lockset ask) in
+ let side_cpa = CPA.filter (fun x _ ->
+ GWeak.fold (fun s' v acc ->
+ (Lockset.mem m s' && not (VD.is_bot v)) || acc
+ ) (fst (getg (mutex_global x))) false
+ ) st.cpa
+ in
+ sideg (mutex_addr_to_varinfo m) (GWeak.bot (), GSync.add s side_cpa (GSync.bot ()));
+ st
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, (GWeak.add (Lockset.empty ()) v (GWeak.bot ()), GSync.bot ()))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Join (* TODO: no problem with branched thread creation here? *)
+ | `Init
+ | `Thread ->
+ (st, [])
+end
+
+module type MineWPrivParam =
+sig
+ (** Whether to side effect global inits to match our traces paper scenario. *)
+ val side_effect_global_init: bool
+end
+
+(** Interference-Based Reading? Side-effecting Mine using W set. *)
+module MineWPriv (Param: MineWPrivParam): S =
+struct
+ include MinePrivBase
+ include LockCenteredGBase
+ open Locksets
+
+ module W =
+ struct
+ include SetDomain.ToppedSet (Basetype.Variables) (struct let topname = "All variables" end)
+ let name () = "W"
+ end
+ module D = W
+
+ let startstate () = W.empty ()
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ let s = current_lockset ask in
+ GWeak.fold (fun s' v acc ->
+ if Lockset.disjoint s s' then
+ VD.join v acc
+ else
+ acc
+ ) (G.weak (getg (mutex_global x))) (CPA.find x st.cpa)
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let s = current_lockset ask in
+ let cpa' = CPA.add x v st.cpa in
+ if not (!GU.earlyglobs && is_precious_glob x) then
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton s v));
+ {st with cpa = cpa'; priv = W.add x st.priv}
+
+ let lock ask getg (st: BaseComponents (D).t) m =
+ let s = current_lockset ask in
+ let cpa' = GSync.fold (fun s' cpa' acc ->
+ if Lockset.disjoint s s' then
+ CPA.join cpa' acc
+ else
+ acc
+ ) (G.sync (getg (mutex_addr_to_varinfo m))) st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let s = Lockset.remove m (current_lockset ask) in
+ let is_in_W x _ = W.mem x st.priv in
+ let side_cpa = CPA.filter is_in_W st.cpa in
+ sideg (mutex_addr_to_varinfo m) (G.create_sync (GSync.singleton s side_cpa));
+ st
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, G.create_weak (GWeak.singleton (Lockset.empty ()) v))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Join (* TODO: no problem with branched thread creation here? *)
+ | `Init
+ | `Thread ->
+ (st, [])
+
+ let escape ask getg sideg st escaped = st (* TODO: do something here when side_effect_global_init? *)
+ let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) =
+ if Param.side_effect_global_init then (
+ CPA.fold (fun x v (st: BaseComponents (D).t) ->
+ if is_global ask x then (
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton (Lockset.empty ()) v));
+ {st with priv = W.add x st.priv} (* TODO: is this add necessary? *)
+ )
+ else
+ st
+ ) st.cpa st
+ )
+ else
+ st
+
+ let threadenter =
+ if Param.side_effect_global_init then
+ startstate_threadenter startstate
+ else
+ old_threadenter
+end
+
+module LockCenteredD =
+struct
+ open Locksets
+
+ module V =
+ struct
+ include MapDomain.MapBot_LiftTop (Lock) (MustVars)
+ let name () = "V"
+ end
+
+ module L =
+ struct
+ include MapDomain.MapBot_LiftTop (Lock) (MinLocksets)
+ let name () = "L"
+ end
+end
+
+(** Lock-Centered Reading. *)
+module LockCenteredPriv: S =
+struct
+ include MinePrivBase
+ include LockCenteredGBase
+ open Locksets
+
+ open LockCenteredD
+ module D = Lattice.Prod (V) (L)
+
+ let startstate () = (V.bot (), L.bot ())
+
+ let lockset_init = Lockset.All
+
+ let distr_init getg x v =
+ if get_bool "exp.priv-distr-init" then
+ let v_init = GWeak.find lockset_init (G.weak (getg (mutex_global x))) in
+ VD.join v v_init
+ else
+ v
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ let s = current_lockset ask in
+ let (vv, l) = st.priv in
+ let d_cpa = CPA.find x st.cpa in
+ let d_sync = L.fold (fun m bs acc ->
+ if not (MustVars.mem x (V.find m vv)) then
+ let syncs = G.sync (getg (mutex_addr_to_varinfo m)) in
+ MinLocksets.fold (fun b acc ->
+ GSync.fold (fun s' cpa' acc ->
+ if Lockset.disjoint b s' then
+ let v = CPA.find x cpa' in
+ VD.join v acc
+ else
+ acc
+ ) syncs acc
+ ) bs acc
+ else
+ acc
+ ) l (VD.bot ())
+ in
+ let weaks = G.weak (getg (mutex_global x)) in
+ let d_weak = GWeak.fold (fun s' v acc ->
+ if Lockset.disjoint s s' then
+ VD.join v acc
+ else
+ acc
+ ) weaks (VD.bot ())
+ in
+ let d_init =
+ if V.exists (fun m cached -> MustVars.mem x cached) vv then
+ VD.bot ()
+ else
+ GWeak.find lockset_init weaks
+ in
+ if M.tracing then M.trace "priv" "d_cpa: %a\n" VD.pretty d_cpa;
+ if M.tracing then M.trace "priv" "d_sync: %a\n" VD.pretty d_sync;
+ if M.tracing then M.trace "priv" "d_weak: %a\n" VD.pretty d_weak;
+ if M.tracing then M.trace "priv" "d_init: %a\n" VD.pretty d_init;
+ let d_weak = VD.join d_weak d_init in
+ let d = VD.join d_cpa (VD.join d_sync d_weak) in
+ d
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let s = current_lockset ask in
+ let (vv, l) = st.priv in
+ let v' = L.fold (fun m _ acc ->
+ V.add m (MustVars.add x (V.find m acc)) acc
+ ) l vv
+ in
+ let cpa' = CPA.add x v st.cpa in
+ if not (!GU.earlyglobs && is_precious_glob x) then (
+ let v = distr_init getg x v in
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton s v))
+ );
+ {st with cpa = cpa'; priv = (v', l)}
+
+ let lock ask getg (st: BaseComponents (D).t) m =
+ let s = current_lockset ask in
+ let (v, l) = st.priv in
+ let v' = V.add m (MustVars.empty ()) v in
+ let l' = L.add m (MinLocksets.singleton s) l in
+ {st with priv = (v', l')}
+
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let s = Lockset.remove m (current_lockset ask) in
+ let is_in_G x _ = is_global ask x in
+ let side_cpa = CPA.filter is_in_G st.cpa in
+ let side_cpa = CPA.mapi (fun x v ->
+ let v = distr_init getg x v in
+ v
+ ) side_cpa
+ in
+ sideg (mutex_addr_to_varinfo m) (G.create_sync (GSync.singleton s side_cpa));
+ (* m stays in v, l *)
+ st
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, G.create_weak (GWeak.singleton (Lockset.empty ()) v))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Join (* TODO: no problem with branched thread creation here? *)
+ | `Init
+ | `Thread ->
+ (st, [])
+
+ let escape ask getg sideg (st: BaseComponents (D).t) escaped =
+ let cpa' = CPA.fold (fun x v acc ->
+ if EscapeDomain.EscapedVars.mem x escaped then (
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton lockset_init v));
+ CPA.remove x acc
+ )
+ else
+ acc
+ ) st.cpa st.cpa
+ in
+ {st with cpa = cpa'}
+
+ let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) =
+ CPA.fold (fun x v (st: BaseComponents (D).t) ->
+ if is_global ask x then (
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton lockset_init v));
+ {st with cpa = CPA.remove x st.cpa}
+ )
+ else
+ st
+ ) st.cpa st
+
+ let threadenter = startstate_threadenter startstate
+end
+
+module WriteCenteredGBase =
+struct
+ open Locksets
+
+ module GWeakW = MapDomain.MapBot (Lockset) (VD)
+ module GSyncW = MapDomain.MapBot (Lockset) (CPA)
+
+ (* weak: G -> (S:2^M -> (W:2^M -> D)) *)
+ (* sync: M -> (S:2^M -> (W:2^M -> (G -> D))) *)
+ include AbstractLockCenteredGBase (GWeakW) (GSyncW)
+end
+
+module WriteCenteredD =
+struct
+ open Locksets
+
+ module W =
+ struct
+ include MapDomain.MapBot_LiftTop (Basetype.Variables) (MinLocksets)
+ let name () = "W"
+ end
+
+ module P =
+ struct
+ (* Note different Map order! *)
+ (* MapTop because default value in P must be top of MinLocksets,
+ as opposed to bottom in W. *)
+ include MapDomain.MapTop_LiftBot (Basetype.Variables) (MinLocksets)
+ let name () = "P"
+
+ (* TODO: change MinLocksets.exists/top instead? *)
+ let find x p = find_opt x p |? MinLocksets.singleton (Lockset.empty ()) (* ensure exists has something to check for thread returns *)
+ end
+end
+
+(** Write-Centered Reading. *)
+module WriteCenteredPriv: S =
+struct
+ include MinePrivBase
+ include WriteCenteredGBase
+ open Locksets
+
+ open WriteCenteredD
+ module D = Lattice.Prod (W) (P)
+
+ let startstate () = (W.bot (), P.top ())
+
+ let lockset_init = Lockset.All
+
+ let distr_init getg x v =
+ if get_bool "exp.priv-distr-init" then
+ let v_init = GWeakW.find lockset_init (GWeak.find (Lockset.empty ()) (G.weak (getg (mutex_global x)))) in
+ VD.join v v_init
+ else
+ v
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ let s = current_lockset ask in
+ let (w, p) = st.priv in
+ let p_x = P.find x p in
+ let d_cpa = CPA.find x st.cpa in
+ let d_sync = Lockset.fold (fun m acc ->
+ if MinLocksets.exists (fun s''' -> not (Lockset.mem m s''')) p_x then
+ let syncs = G.sync (getg (mutex_addr_to_varinfo m)) in
+ GSync.fold (fun s' gsyncw' acc ->
+ if Lockset.disjoint s s' then
+ GSyncW.fold (fun w' cpa' acc ->
+ if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then
+ let v = CPA.find x cpa' in
+ VD.join v acc
+ else
+ acc
+ ) gsyncw' acc
+ else
+ acc
+ ) syncs acc
+ else
+ acc
+ ) s (VD.bot ())
+ in
+ let weaks = G.weak (getg (mutex_global x)) in
+ let d_weak = GWeak.fold (fun s' gweakw' acc ->
+ if Lockset.disjoint s s' then
+ GWeakW.fold (fun w' v acc ->
+ if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then
+ VD.join v acc
+ else
+ acc
+ ) gweakw' acc
+ else
+ acc
+ ) weaks (VD.bot ())
+ in
+ if M.tracing then M.trace "priv" "d_cpa: %a\n" VD.pretty d_cpa;
+ if M.tracing then M.trace "priv" "d_sync: %a\n" VD.pretty d_sync;
+ if M.tracing then M.trace "priv" "d_weak: %a\n" VD.pretty d_weak;
+ let d = VD.join d_cpa (VD.join d_sync d_weak) in
+ d
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let s = current_lockset ask in
+ let (w, p) = st.priv in
+ let w' = W.add x (MinLocksets.singleton s) w in
+ let p' = P.add x (MinLocksets.singleton s) p in
+ let p' = P.map (fun s' -> MinLocksets.add s s') p' in
+ let cpa' = CPA.add x v st.cpa in
+ if not (!GU.earlyglobs && is_precious_glob x) then (
+ let v = distr_init getg x v in
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton s (GWeakW.singleton s v)))
+ );
+ (* TODO: publish all g under M_g? *)
+ {st with cpa = cpa'; priv = (w', p')}
+
+ let lock ask getg (st: BaseComponents (D).t) m = st
+
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let s = Lockset.remove m (current_lockset ask) in
+ let (w, p) = st.priv in
+ let p' = P.map (fun s' -> MinLocksets.add s s') p in
+ if M.tracing then M.traceli "priv" "unlock %a %a\n" Lock.pretty m CPA.pretty st.cpa;
+ let side_gsyncw = CPA.fold (fun x v acc ->
+ if is_global ask x then (
+ let w_x = W.find x w in
+ if M.tracing then M.trace "priv" "gsyncw %a %a %a\n" d_varinfo x VD.pretty v MinLocksets.pretty w_x;
+ MinLocksets.fold (fun w acc ->
+ let v = distr_init getg x v in
+ GSyncW.add w (CPA.add x v (GSyncW.find w acc)) acc
+ ) w_x acc
+ ) else
+ acc
+ ) st.cpa (GSyncW.bot ())
+ in
+ if M.tracing then M.traceu "priv" "unlock %a %a\n" Lock.pretty m GSyncW.pretty side_gsyncw;
+ sideg (mutex_addr_to_varinfo m) (G.create_sync (GSync.singleton s side_gsyncw));
+ {st with priv = (w, p')}
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, G.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton (Lockset.empty ()) v)))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Join (* TODO: no problem with branched thread creation here? *)
+ | `Init
+ | `Thread ->
+ (st, [])
+
+ let escape ask getg sideg (st: BaseComponents (D).t) escaped =
+ let s = current_lockset ask in
+ CPA.fold (fun x v acc ->
+ if EscapeDomain.EscapedVars.mem x escaped then (
+ let (w, p) = st.priv in
+ let p' = P.add x (MinLocksets.singleton s) p in
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v)));
+ {st with cpa = CPA.remove x st.cpa; priv = (w, p')}
+ )
+ else
+ st
+ ) st.cpa st
+
+ let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) =
+ CPA.fold (fun x v (st: BaseComponents (D).t) ->
+ if is_global ask x then (
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v)));
+ {st with cpa = CPA.remove x st.cpa}
+ )
+ else
+ st
+ ) st.cpa st
+
+ let threadenter = startstate_threadenter startstate
+end
+
+(** Write-Centered Reading and Lock-Centered Reading combined. *)
+module WriteAndLockCenteredPriv: S =
+struct
+ include MinePrivBase
+ include WriteCenteredGBase
+ open Locksets
+
+ open LockCenteredD
+ open WriteCenteredD
+ module D = Lattice.Prod (Lattice.Prod (W) (P)) (Lattice.Prod (V) (L))
+
+ let startstate () = ((W.bot (), P.top ()), (V.bot (), L.bot ()))
+
+ let lockset_init = Lockset.All
+
+ let distr_init getg x v =
+ if get_bool "exp.priv-distr-init" then
+ let v_init = GWeakW.find lockset_init (GWeak.find (Lockset.empty ()) (G.weak (getg (mutex_global x)))) in
+ VD.join v v_init
+ else
+ v
+
+ let read_global ask getg (st: BaseComponents (D).t) x =
+ let s = current_lockset ask in
+ let ((w, p), (vv, l)) = st.priv in
+ let p_x = P.find x p in
+ let d_cpa = CPA.find x st.cpa in
+ let d_m_sync = L.fold (fun m bs acc ->
+ if not (MustVars.mem x (V.find m vv)) then
+ let syncs = G.sync (getg (mutex_addr_to_varinfo m)) in
+ MinLocksets.fold (fun b acc ->
+ GSync.fold (fun s' gsyncw' acc ->
+ if Lockset.disjoint b s' then
+ GSyncW.fold (fun w' cpa' acc ->
+ if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then
+ let v = CPA.find x cpa' in
+ VD.join v acc
+ else
+ acc
+ ) gsyncw' acc
+ else
+ acc
+ ) syncs acc
+ ) bs acc
+ else
+ acc
+ ) l (VD.bot ())
+ in
+ let weaks = G.weak (getg (mutex_global x)) in
+ let d_m_weak = GWeak.fold (fun s' gweakw' acc ->
+ if Lockset.disjoint s s' then
+ GWeakW.fold (fun w' v acc ->
+ if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then
+ VD.join v acc
+ else
+ acc
+ ) gweakw' acc
+ else
+ acc
+ ) weaks (VD.bot ())
+ in
+ let d_m = VD.join d_m_sync d_m_weak in
+ let d_g_sync = Lockset.fold (fun m acc ->
+ if MinLocksets.exists (fun s''' -> not (Lockset.mem m s''')) p_x then
+ let syncs = G.sync (getg (mutex_addr_to_varinfo m)) in
+ GSync.fold (fun s' gsyncw' acc ->
+ if Lockset.disjoint s s' then
+ GSyncW.fold (fun w' cpa' acc ->
+ if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then
+ let v = CPA.find x cpa' in
+ VD.join v acc
+ else
+ acc
+ ) gsyncw' acc
+ else
+ acc
+ ) syncs acc
+ else
+ acc
+ ) s (VD.bot ())
+ in
+ let d_g_weak = d_m_weak in (* happen to coincide *)
+ let d_g = VD.join d_g_sync d_g_weak in
+ let d = VD.join d_cpa (VD.meet d_m d_g) in
+ d
+
+ let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v =
+ let s = current_lockset ask in
+ let ((w, p), (vv, l)) = st.priv in
+ let w' = W.add x (MinLocksets.singleton s) w in
+ let p' = P.add x (MinLocksets.singleton s) p in
+ let p' = P.map (fun s' -> MinLocksets.add s s') p' in
+ let v' = L.fold (fun m _ acc ->
+ V.add m (MustVars.add x (V.find m acc)) acc
+ ) l vv
+ in
+ let cpa' = CPA.add x v st.cpa in
+ if not (!GU.earlyglobs && is_precious_glob x) then (
+ let v = distr_init getg x v in
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton s (GWeakW.singleton s v)))
+ );
+ (* TODO: publish all g under M_g? *)
+ {st with cpa = cpa'; priv = ((w', p'), (v', l))}
+
+ let lock ask getg (st: BaseComponents (D).t) m =
+ let s = current_lockset ask in
+ let (wp, (v, l)) = st.priv in
+ let v' = V.add m (MustVars.empty ()) v in
+ let l' = L.add m (MinLocksets.singleton s) l in
+ {st with priv = (wp, (v', l'))}
+
+ let unlock ask getg sideg (st: BaseComponents (D).t) m =
+ let s = Lockset.remove m (current_lockset ask) in
+ let ((w, p), vl) = st.priv in
+ let p' = P.map (fun s' -> MinLocksets.add s s') p in
+ let side_gsyncw = CPA.fold (fun x v acc ->
+ if is_global ask x then
+ MinLocksets.fold (fun w acc ->
+ let v = distr_init getg x v in
+ GSyncW.add w (CPA.add x v (GSyncW.find w acc)) acc
+ ) (W.find x w) acc
+ else
+ acc
+ ) st.cpa (GSyncW.bot ())
+ in
+ sideg (mutex_addr_to_varinfo m) (G.create_sync (GSync.singleton s side_gsyncw));
+ (* m stays in v, l *)
+ {st with priv = ((w, p'), vl)}
+
+ let sync ask getg (st: BaseComponents (D).t) reason =
+ match reason with
+ | `Return -> (* required for thread return *)
+ begin match ThreadId.get_current ask with
+ | `Lifted x when CPA.mem x st.cpa ->
+ let v = CPA.find x st.cpa in
+ ({st with cpa = CPA.remove x st.cpa}, [(mutex_global x, G.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton (Lockset.empty ()) v)))])
+ | _ ->
+ (st, [])
+ end
+ | `Normal
+ | `Join (* TODO: no problem with branched thread creation here? *)
+ | `Init
+ | `Thread ->
+ (st, [])
+
+ let escape ask getg sideg (st: BaseComponents (D).t) escaped =
+ let s = current_lockset ask in
+ CPA.fold (fun x v acc ->
+ if EscapeDomain.EscapedVars.mem x escaped then (
+ let ((w, p), (vv, l)) = st.priv in
+ let p' = P.add x (MinLocksets.singleton s) p in
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v)));
+ {st with cpa = CPA.remove x st.cpa; priv = ((w, p'), (vv, l))}
+ )
+ else
+ st
+ ) st.cpa st
+
+ let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) =
+ CPA.fold (fun x v (st: BaseComponents (D).t) ->
+ if is_global ask x then (
+ sideg (mutex_global x) (G.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v)));
+ {st with cpa = CPA.remove x st.cpa}
+ )
+ else
+ st
+ ) st.cpa st
+
+ let threadenter = startstate_threadenter startstate
+end
+
+module TimedPriv (Priv: S): S with module D = Priv.D =
+struct
+ module D = Priv.D
+ module G = Priv.G
+
+ let time str f arg = Stats.time "priv" (Stats.time str f) arg
+
+ let startstate = Priv.startstate
+ let read_global ask getg st x = time "read_global" (Priv.read_global ask getg st) x
+ let write_global ?invariant ask getg sideg st x v = time "write_global" (Priv.write_global ?invariant ask getg sideg st x) v
+ let lock ask getg cpa m = time "lock" (Priv.lock ask getg cpa) m
+ let unlock ask getg sideg st m = time "unlock" (Priv.unlock ask getg sideg st) m
+ let sync reason ctx = time "sync" (Priv.sync reason) ctx
+ let escape ask getg sideg st escaped = time "escape" (Priv.escape ask getg sideg st) escaped
+ let enter_multithreaded ask getg sideg st = time "enter_multithreaded" (Priv.enter_multithreaded ask getg sideg) st
+ let threadenter ask st = time "threadenter" (Priv.threadenter ask) st
+
+ let init () = time "init" (Priv.init) ()
+ let finalize () = time "finalize" (Priv.finalize) ()
+end
+
+module PrecisionDumpPriv (Priv: S): S with module D = Priv.D =
+struct
+ include Priv
+
+ open PrivPrecCompareUtil
+
+ let is_dumping = ref false
+ let lvh = LVH.create 113
+
+ let init () =
+ Priv.init ();
+ is_dumping := get_string "exp.priv-prec-dump" <> "";
+ LVH.clear lvh
+
+ let read_global ask getg st x =
+ let v = Priv.read_global ask getg st x in
+ if !GU.in_verifying_stage && !is_dumping then
+ LVH.modify_def (VD.bot ()) (!Tracing.current_loc, x) (VD.join v) lvh;
+ v
+
+ let dump () =
+ let f = open_out_bin (get_string "exp.priv-prec-dump") in
+ (* LVH.iter (fun (l, x) v ->
+ ignore (Pretty.printf "%a %a = %a\n" d_loc l d_varinfo x VD.pretty v)
+ ) lvh; *)
+ Marshal.output f {name = get_string "exp.privatization"; lvh};
+ close_out_noerr f
+
+ let finalize () =
+ if !is_dumping then
+ dump ();
+ Priv.finalize ()
+end
+
+module TracingPriv (Priv: S): S with module D = Priv.D =
+struct
+ include Priv
+
+ module BaseComponents = BaseComponents (D)
+
+ let read_global ask getg st x =
+ if M.tracing then M.traceli "priv" "read_global %a\n" d_varinfo x;
+ if M.tracing then M.trace "priv" "st: %a\n" BaseComponents.pretty st;
+ let getg x =
+ let r = getg x in
+ if M.tracing then M.trace "priv" "getg %a -> %a\n" d_varinfo x G.pretty r;
+ r
+ in
+ let v = Priv.read_global ask getg st x in
+ if M.tracing then M.traceu "priv" "-> %a\n" VD.pretty v;
+ v
+
+ let write_global ?invariant ask getg sideg st x v =
+ if M.tracing then M.traceli "priv" "write_global %a %a\n" d_varinfo x VD.pretty v;
+ if M.tracing then M.trace "priv" "st: %a\n" BaseComponents.pretty st;
+ let getg x =
+ let r = getg x in
+ if M.tracing then M.trace "priv" "getg %a -> %a\n" d_varinfo x G.pretty r;
+ r
+ in
+ let sideg x v =
+ if M.tracing then M.trace "priv" "sideg %a %a\n" d_varinfo x G.pretty v;
+ sideg x v
+ in
+ let r = write_global ?invariant ask getg sideg st x v in
+ if M.tracing then M.traceu "priv" "-> %a\n" BaseComponents.pretty r;
+ r
+
+ let lock ask getg st m =
+ if M.tracing then M.traceli "priv" "lock %a\n" LockDomain.Addr.pretty m;
+ if M.tracing then M.trace "priv" "st: %a\n" BaseComponents.pretty st;
+ let getg x =
+ let r = getg x in
+ if M.tracing then M.trace "priv" "getg %a -> %a\n" d_varinfo x G.pretty r;
+ r
+ in
+ let r = lock ask getg st m in
+ if M.tracing then M.traceu "priv" "-> %a\n" BaseComponents.pretty r;
+ r
+
+ let unlock ask getg sideg st m =
+ if M.tracing then M.traceli "priv" "unlock %a\n" LockDomain.Addr.pretty m;
+ if M.tracing then M.trace "priv" "st: %a\n" BaseComponents.pretty st;
+ let getg x =
+ let r = getg x in
+ if M.tracing then M.trace "priv" "getg %a -> %a\n" d_varinfo x G.pretty r;
+ r
+ in
+ let sideg x v =
+ if M.tracing then M.trace "priv" "sideg %a %a\n" d_varinfo x G.pretty v;
+ sideg x v
+ in
+ let r = unlock ask getg sideg st m in
+ if M.tracing then M.traceu "priv" "-> %a\n" BaseComponents.pretty r;
+ r
+
+ let enter_multithreaded ask getg sideg st =
+ if M.tracing then M.traceli "priv" "enter_multithreaded\n";
+ if M.tracing then M.trace "priv" "st: %a\n" BaseComponents.pretty st;
+ let getg x =
+ let r = getg x in
+ if M.tracing then M.trace "priv" "getg %a -> %a\n" d_varinfo x G.pretty r;
+ r
+ in
+ let sideg x v =
+ if M.tracing then M.trace "priv" "sideg %a %a\n" d_varinfo x G.pretty v;
+ sideg x v
+ in
+ let r = enter_multithreaded ask getg sideg st in
+ if M.tracing then M.traceu "priv" "-> %a\n" BaseComponents.pretty r;
+ r
+
+ let threadenter ask st =
+ if M.tracing then M.traceli "priv" "threadenter\n";
+ if M.tracing then M.trace "priv" "st: %a\n" BaseComponents.pretty st;
+ let r = threadenter ask st in
+ if M.tracing then M.traceu "priv" "-> %a\n" BaseComponents.pretty r;
+ r
+
+ let sync ask getg st reason =
+ if M.tracing then M.traceli "priv" "sync\n";
+ if M.tracing then M.trace "priv" "st: %a\n" BaseComponents.pretty st;
+ let getg x =
+ let r = getg x in
+ if M.tracing then M.trace "priv" "getg %a -> %a\n" d_varinfo x G.pretty r;
+ r
+ in
+ let sideg x v =
+ if M.tracing then M.trace "priv" "sideg %a %a\n" d_varinfo x G.pretty v
+ in
+ let (r, rsideg) = sync ask getg st reason in
+ List.iter (uncurry sideg) rsideg;
+ if M.tracing then M.traceu "priv" "-> %a\n" BaseComponents.pretty r;
+ (r, rsideg)
+
+end
+
+let priv_module: (module S) Lazy.t =
+ lazy (
+ let module Priv: S =
+ (val match get_string "exp.privatization" with
+ | "none" -> (module NonePriv: S)
+ | "protection-old" -> (module ProtectionBasedOldPriv)
+ | "mutex-oplus" -> (module PerMutexOplusPriv)
+ | "mutex-meet" -> (module PerMutexMeetPriv)
+ | "protection" -> (module ProtectionBasedPriv (struct let check_read_unprotected = false end))
+ | "protection-read" -> (module ProtectionBasedPriv (struct let check_read_unprotected = true end))
+ | "protection-vesal" -> (module ProtectionBasedVesalPriv)
+ | "mine" -> (module MinePriv)
+ | "mine-nothread" -> (module MineNoThreadPriv)
+ | "mine-W" -> (module MineWPriv (struct let side_effect_global_init = true end))
+ | "mine-W-noinit" -> (module MineWPriv (struct let side_effect_global_init = false end))
+ | "lock" -> (module LockCenteredPriv)
+ | "write" -> (module WriteCenteredPriv)
+ | "write+lock" -> (module WriteAndLockCenteredPriv)
+ | _ -> failwith "exp.privatization: illegal value"
+ )
+ in
+ let module Priv = PrecisionDumpPriv (Priv) in
+ (* let module Priv = TimedPriv (Priv) in *)
+ let module Priv = TracingPriv (Priv) in
+ (module Priv)
+ )
+
+let get_priv (): (module S) =
+ Lazy.force priv_module
\ No newline at end of file
diff --git a/src/analyses/basePriv.mli b/src/analyses/basePriv.mli
new file mode 100644
index 0000000000..eab4417edc
--- /dev/null
+++ b/src/analyses/basePriv.mli
@@ -0,0 +1,27 @@
+open Cil
+(* Cannot use local module substitutions because ppx_import is still stuck at 4.07 AST: https://github.com/ocaml-ppx/ppx_import/issues/50#issuecomment-775817579. *)
+
+module type S =
+sig
+ module D: Lattice.S
+ module G: Lattice.S
+
+ val startstate: unit -> D.t
+
+ val read_global: Queries.ask -> (varinfo -> G.t) -> BaseDomain.BaseComponents (D).t -> varinfo -> BaseDomain.VD.t
+ val write_global: ?invariant:bool -> Queries.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> varinfo -> BaseDomain.VD.t -> BaseDomain.BaseComponents (D).t
+
+ val lock: Queries.ask -> (varinfo -> G.t) -> BaseDomain.BaseComponents (D).t -> LockDomain.Addr.t -> BaseDomain.BaseComponents (D).t
+ val unlock: Queries.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> LockDomain.Addr.t -> BaseDomain.BaseComponents (D).t
+
+ val sync: Queries.ask -> (varinfo -> G.t) -> BaseDomain.BaseComponents (D).t -> [`Normal | `Join | `Return | `Init | `Thread] -> BaseDomain.BaseComponents (D).t * (varinfo * G.t) list
+
+ val escape: Queries.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> EscapeDomain.EscapedVars.t -> BaseDomain.BaseComponents (D).t
+ val enter_multithreaded: Queries.ask -> (varinfo -> G.t) -> (varinfo -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t
+ val threadenter: Queries.ask -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t
+
+ val init: unit -> unit
+ val finalize: unit -> unit
+end
+
+val get_priv : unit -> (module S)
diff --git a/src/analyses/baseUtil.ml b/src/analyses/baseUtil.ml
new file mode 100644
index 0000000000..7edccda8d0
--- /dev/null
+++ b/src/analyses/baseUtil.ml
@@ -0,0 +1,19 @@
+open Prelude.Ana
+open GobConfig
+module Q = Queries
+
+let is_global (a: Q.ask) (v: varinfo): bool =
+ v.vglob || ThreadEscape.has_escaped a v
+
+let is_static (v:varinfo): bool = v.vstorage = Static
+
+let is_always_unknown variable = variable.vstorage = Extern || Ciltools.is_volatile_tp variable.vtype
+
+let precious_globs = ref []
+let is_precious_glob v = List.mem v.vname !precious_globs
+
+let after_config () =
+ precious_globs := List.map Json.string (get_list "exp.precious_globs")
+
+let _ =
+ AfterConfig.register after_config
\ No newline at end of file
diff --git a/src/analyses/baseUtil.mli b/src/analyses/baseUtil.mli
new file mode 100644
index 0000000000..93eab6e7d3
--- /dev/null
+++ b/src/analyses/baseUtil.mli
@@ -0,0 +1,6 @@
+open Cil
+
+val is_global: Queries.ask -> varinfo -> bool
+val is_static: varinfo -> bool
+val is_always_unknown: varinfo -> bool
+val is_precious_glob: varinfo -> bool
diff --git a/src/analyses/condVars.ml b/src/analyses/condVars.ml
index b1f7f125f0..306b36fbbd 100644
--- a/src/analyses/condVars.ml
+++ b/src/analyses/condVars.ml
@@ -143,10 +143,10 @@ struct
ctx.local
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.bot ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.bot ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/constants.ml b/src/analyses/constants.ml
index 037f00e9dd..386bae41ef 100644
--- a/src/analyses/constants.ml
+++ b/src/analyses/constants.ml
@@ -5,7 +5,7 @@ open Analyses
(** An analysis specification for didactic purposes.
It only considers definite values of local variables.
We do not pass information interprocedurally. *)
-module Spec : Analyses.Spec =
+module Spec : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
@@ -96,10 +96,10 @@ struct
set_local_int_lval_top ctx.local lval
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.top ()
+ let threadenter ctx lval f args = [D.top ()]
let threadspawn ctx lval f args fctx = D.bot ()
let exitstate v = D.top ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/contain.ml b/src/analyses/contain.ml
index 41b99dd07c..84d4741438 100644
--- a/src/analyses/contain.ml
+++ b/src/analyses/contain.ml
@@ -113,7 +113,7 @@ struct
let init () =
init_inh_rel ();
Printexc.record_backtrace true;
- iterGlobals (!Cilfacade.ugglyImperativeHack) (function GFun (f,_) -> incr funcount| _ -> ());
+ iterGlobals (!Cilfacade.current_file) (function GFun (f,_) -> incr funcount| _ -> ());
ignore (if (get_bool "allfuns") then ignore (printf "CUR VER_ALL FUNS\n"));
let ctrl = Gc.get () in
ctrl.Gc.verbose <- 0;
@@ -206,7 +206,7 @@ struct
(not no_mainclass) && (D.is_private_method_name f.vname) (*uncomenting the rest brakes fptr propagation*)(*&& not (D.is_public_method_name f.vname)*) (*fun may be priv andpub simultaneously*)
- let sync ctx =
+ let sync ctx reason =
let (x,y,z:D.t) = ctx.local in (x, y, ContainDomain.Diff.empty ()), ContainDomain.Diff.elements z
let time_transfer n f =
@@ -805,11 +805,11 @@ struct
end
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.bot ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.bot ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/deadlock.ml b/src/analyses/deadlock.ml
index 4d30b7415c..208b3ac574 100644
--- a/src/analyses/deadlock.ml
+++ b/src/analyses/deadlock.ml
@@ -52,8 +52,8 @@ struct
(* Some required states *)
let startstate _ : D.t = D.empty ()
- let threadenter ctx lval f args : D.t = D.empty ()
- let threadspawn ctx lval f args fctx = D.empty ()
+ let threadenter ctx lval f args = [D.empty ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate _ : D.t = D.empty ()
(* ======== Transfer functions ======== *)
@@ -120,4 +120,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/deadlocksByRaces.ml b/src/analyses/deadlocksByRaces.ml
index 3357d37743..53eb00d53c 100644
--- a/src/analyses/deadlocksByRaces.ml
+++ b/src/analyses/deadlocksByRaces.ml
@@ -57,4 +57,4 @@ struct
end
let _ =
- MCP.register_analysis ~dep:["thread-id-location";"maylocks"] (module Spec : Spec)
+ MCP.register_analysis ~dep:["thread-id-location";"maylocks"] (module Spec : MCPSpec)
diff --git a/src/analyses/expRelation.ml b/src/analyses/expRelation.ml
index 8c6f5e9205..410f4504ab 100644
--- a/src/analyses/expRelation.ml
+++ b/src/analyses/expRelation.ml
@@ -5,7 +5,7 @@
open Prelude.Ana
open Analyses
-module Spec : Analyses.Spec =
+module Spec : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
module D = Lattice.Unit
@@ -112,10 +112,10 @@ struct
ctx.local
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/extract_arinc.ml b/src/analyses/extract_arinc.ml
index 097bfb4645..40829b6537 100644
--- a/src/analyses/extract_arinc.ml
+++ b/src/analyses/extract_arinc.ml
@@ -215,7 +215,8 @@ struct
match List.assoc "base" ctx.presub with
| Some base ->
let pid, ctxh, pred = ctx.local in
- let base_context = Base.Main.context_cpa @@ Obj.obj base in
+ let module BaseMain = (val Base.get_main ()) in
+ let base_context = BaseMain.context_cpa @@ Obj.obj base in
let context_hash = Hashtbl.hash (base_context, pid) in
pid, Ctx.of_int (Int64.of_int context_hash), pred
| None -> ctx.local (* TODO when can this happen? *)
@@ -398,10 +399,10 @@ struct
) tasks
in
let f_d = snd (Tasks.choose tasks_f) in
- f_d
+ [f_d]
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadspawn ctx lval f args fctx = ctx.local
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/extract_osek.ml b/src/analyses/extract_osek.ml
index 96a593a600..ddb17c560a 100644
--- a/src/analyses/extract_osek.ml
+++ b/src/analyses/extract_osek.ml
@@ -208,7 +208,8 @@ struct
match List.assoc "base" ctx.presub with
| Some base ->
let pid, ctxh, pred = ctx.local in
- let base_context = Base.Main.context_cpa @@ Obj.obj base in
+ let module BaseMain = (val Base.get_main ()) in
+ let base_context = BaseMain.context_cpa @@ Obj.obj base in
let context_hash = Hashtbl.hash (base_context, pid) in
pid, Ctx.of_int (Int64.of_int context_hash), pred
| None -> ctx.local (* TODO when can this happen? *)
@@ -316,8 +317,8 @@ struct
) ctx.local args_product
let startstate v = Pid.of_int 0L, Ctx.top (), Pred.of_node (MyCFG.Function (emptyFunction "main").svar)
- let threadenter ctx lval f args = D.bot ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.bot ()
let init () = (* registers which functions to extract and writes out their definitions *)
@@ -335,4 +336,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/fileUse.ml b/src/analyses/fileUse.ml
index e7a679519e..ed8df0efbf 100644
--- a/src/analyses/fileUse.ml
+++ b/src/analyses/fileUse.ml
@@ -213,7 +213,7 @@ struct
let split_err_branch lval dom =
(* type? NULL = 0 = 0-ptr? Cil.intType, Cil.intPtrType, Cil.voidPtrType -> no difference *)
if not (GobConfig.get_bool "ana.file.optimistic") then
- ctx.split dom (Cil.BinOp (Cil.Eq, Cil.Lval lval, Cil.integer 0, Cil.intType)) true;
+ ctx.split dom [Events.SplitBranch ((Cil.BinOp (Cil.Eq, Cil.Lval lval, Cil.integer 0, Cil.intType)), true)];
dom
in
(* fold possible keys on domain *)
@@ -296,10 +296,10 @@ struct
| _ -> m
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.bot ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.bot ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/flag.ml b/src/analyses/flag.ml
index 9b09270faa..8c874a7061 100644
--- a/src/analyses/flag.ml
+++ b/src/analyses/flag.ml
@@ -126,8 +126,8 @@ struct
match f.vname with _ -> D.top ()
let startstate v = D.top ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
let name () = "flag"
@@ -149,4 +149,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/flagModes.ml b/src/analyses/flagModes.ml
index 31d88595f1..73a9a60062 100644
--- a/src/analyses/flagModes.ml
+++ b/src/analyses/flagModes.ml
@@ -130,10 +130,10 @@ struct
ctx.local
let startstate v = D.top ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml
index 80f16d2a48..0ad279603c 100644
--- a/src/analyses/libraryFunctions.ml
+++ b/src/analyses/libraryFunctions.ml
@@ -322,6 +322,7 @@ let invalidate_actions = ref [
"svcudp_create", readsAll;(*safe*)
"svc_register", writesAll;(*unsafe*)
"sleep", readsAll;(*safe*)
+ "usleep", readsAll;
"svc_run", writesAll;(*unsafe*)
"dup", readsAll; (*safe*)
"__builtin_expect", readsAll; (*safe*)
@@ -459,11 +460,11 @@ let get_threadsafe_inv_ac name =
-let lib_funs = ref (Set.String.of_list ["list_empty"; "__raw_read_unlock"; "__raw_write_unlock"; "spinlock_check"; "spin_trylock"; "spin_unlock_irqrestore"])
+let lib_funs = ref (Set.String.of_list ["list_empty"; "__raw_read_unlock"; "__raw_write_unlock"; "spin_trylock"])
let add_lib_funs funs = lib_funs := List.fold_right Set.String.add funs !lib_funs
let use_special fn_name = Set.String.mem fn_name !lib_funs
-let effects = ref []
+let effects: (string -> Cil.exp list -> (Cil.lval * ValueDomain.Compound.t) list option) list ref = ref []
let add_effects f = effects := f :: !effects
let effects_for fname args = List.filter_map (fun f -> f fname args) !effects
diff --git a/src/analyses/libraryFunctions.mli b/src/analyses/libraryFunctions.mli
index 361fd0177d..7082182b54 100644
--- a/src/analyses/libraryFunctions.mli
+++ b/src/analyses/libraryFunctions.mli
@@ -36,8 +36,8 @@ val get_threadsafe_inv_ac : string -> (action -> exp list -> exp list) option
val add_lib_funs : string list -> unit
(* can't use Base.Main.store b/c of circular build - this is painful... *)
-val add_effects : (string -> Cil.exp list -> ((Cil.lval -> ValueDomain.Compound.t -> BaseDomain.CPA.t * BaseDomain.PartDeps.t) -> BaseDomain.CPA.t * BaseDomain.PartDeps.t) option) -> unit
-val effects_for : string -> Cil.exp list -> ((Cil.lval -> ValueDomain.Compound.t -> BaseDomain.CPA.t * BaseDomain.PartDeps.t) -> BaseDomain.CPA.t * BaseDomain.PartDeps.t) list
+val add_effects : (string -> Cil.exp list -> (Cil.lval * ValueDomain.Compound.t) list option) -> unit
+val effects_for : string -> Cil.exp list -> (Cil.lval * ValueDomain.Compound.t) list list
val use_special : string -> bool
(** This is for when we need to use special transfer function on functions calls that have definitions.
diff --git a/src/analyses/mCP.ml b/src/analyses/mCP.ml
index e145af2f3e..673e6e31ff 100644
--- a/src/analyses/mCP.ml
+++ b/src/analyses/mCP.ml
@@ -4,7 +4,7 @@ open Prelude.Ana
open GobConfig
open Analyses
-type spec_modules = { spec : (module Spec)
+type spec_modules = { spec : (module MCPSpec)
; dom : (module Lattice.S)
; glob : (module Lattice.S)
; cont : (module Printable.S) }
@@ -18,8 +18,8 @@ let analyses_table = ref []
let register_analysis =
let count = ref 0 in
- fun ?(dep=[]) (module S:Spec) ->
- let s = { spec = (module S : Spec)
+ fun ?(dep=[]) (module S:MCPSpec) ->
+ let s = { spec = (module S : MCPSpec)
; dom = (module S.D : Lattice.S)
; glob = (module S.G : Lattice.S)
; cont = (module S.C : Printable.S)
@@ -284,9 +284,9 @@ struct
Printf.printf "\n";
iter (Printf.printf "%s\n" % flip assoc !analyses_table % fst) !analyses_list;
Printf.printf "\n";*)
- iter (fun (_,{spec=(module S:Spec); _}) -> S.init ()) !analyses_list
+ iter (fun (_,{spec=(module S:MCPSpec); _}) -> S.init ()) !analyses_list
- let finalize () = iter (fun (_,{spec=(module S:Spec); _}) -> S.finalize ()) !analyses_list
+ let finalize () = iter (fun (_,{spec=(module S:MCPSpec); _}) -> S.finalize ()) !analyses_list
let spec x = (assoc x !analyses_list).spec
let spec_list xs =
@@ -295,14 +295,14 @@ struct
let map_deadcode f xs =
let dead = ref false in
- let one_el xs (n,(module S:Spec),d) = try f xs (n,(module S:Spec),d) :: xs with Deadcode -> dead:=true; (n,repr @@ S.D.bot ()) :: xs in
+ let one_el xs (n,(module S:MCPSpec),d) = try f xs (n,(module S:MCPSpec),d) :: xs with Deadcode -> dead:=true; (n,repr @@ S.D.bot ()) :: xs in
let ys = fold_left one_el [] xs in
List.rev ys, !dead
let val_of = identity
let context x =
let x = spec_list x in
- map (fun (n,(module S:Spec),d) ->
+ map (fun (n,(module S:MCPSpec),d) ->
let d' = if mem n !cont_inse then S.D.top () else obj d in
n, repr @@ S.context d'
) x
@@ -314,7 +314,7 @@ struct
| _,_ , []-> []
| (x::xs),(y::ys), (z::zs) -> (x,y,z)::(zip3 xs ys zs)
in
- let should_join ((_,(module S:Analyses.Spec),_),(_,x),(_,y)) = S.should_join (obj x) (obj y) in
+ let should_join ((_,(module S:Analyses.MCPSpec),_),(_,x),(_,y)) = S.should_join (obj x) (obj y) in
(* obtain all analyses specs that are path sensitive and their values both in x and y *)
let specs = filter (fun (x,_,_) -> mem x !path_sens) (spec_list x) in
let xs = filter (fun (x,_) -> mem x !path_sens) x in
@@ -322,13 +322,13 @@ struct
let zipped = zip3 specs xs ys in
List.for_all should_join zipped
- let exitstate v = map (fun (n,{spec=(module S:Spec); _}) -> n, repr @@ S.exitstate v) !analyses_list
- let startstate v = map (fun (n,{spec=(module S:Spec); _}) -> n, repr @@ S.startstate v) !analyses_list
- let morphstate v x = map (fun (n,(module S:Spec),d) -> n, repr @@ S.morphstate v (obj d)) (spec_list x)
+ let exitstate v = map (fun (n,{spec=(module S:MCPSpec); _}) -> n, repr @@ S.exitstate v) !analyses_list
+ let startstate v = map (fun (n,{spec=(module S:MCPSpec); _}) -> n, repr @@ S.startstate v) !analyses_list
+ let morphstate v x = map (fun (n,(module S:MCPSpec),d) -> n, repr @@ S.morphstate v (obj d)) (spec_list x)
let call_descr f xs =
let xs = filter (fun (x,_) -> x = !base_id) xs in
- fold_left (fun a (n,(module S:Spec),d) -> S.call_descr f (obj d)) f.svar.vname @@ spec_list xs
+ fold_left (fun a (n,(module S:MCPSpec),d) -> S.call_descr f (obj d)) f.svar.vname @@ spec_list xs
let rec assoc_replace (n,c) = function
@@ -378,7 +378,7 @@ struct
let do_sideg ctx (xs:(varinfo * (int * Obj.t)) list) =
let side_one v d =
- let join_vals (n,(module S:Spec),d) =
+ let join_vals (n,(module S:MCPSpec),d) =
n, repr @@ fold_left (fun x y -> S.G.join x (obj y)) (S.G.bot ()) d
in
ctx.sideg v @@ topo_sort_an @@ map join_vals @@ spec_list @@ group_assoc (d @ G.bot ())
@@ -390,7 +390,7 @@ struct
else
let spec_assign n d : Obj.t =
(* spec of current analysis *)
- let (module S:Spec) = spec n in
+ let (module S:MCPSpec) = spec n in
let assign_one d (lval, exp, name, ctx) =
match name with
| Some x when x <> spec_name n -> obj d (* do nothing if current spec name is filtered out *)
@@ -409,19 +409,93 @@ struct
finalize ();
Access.print_result ()
- let rec do_splits ctx pv (xs:(int * (Obj.t * exp * bool)) list) =
- let split_one n (d,e,tv) =
+ let rec do_splits ctx pv (xs:(int * (Obj.t * Events.t list)) list) =
+ let split_one n (d,emits) =
let nv = assoc_replace (n,d) pv in
- ctx.split (branch {ctx with local = nv} e tv) one true
+ ctx.split (do_emits ctx emits nv) []
in
iter (uncurry split_one) xs
+ and do_emits ctx emits xs =
+ let octx = ctx in
+ let ctx_with_local ctx local' =
+ (* let rec ctx' =
+ { ctx with
+ local = local';
+ ask = ask
+ }
+ and ask q = query ctx' q
+ in
+ ctx' *)
+ {ctx with local = local'}
+ in
+ let do_emit ctx = function
+ | Events.SplitBranch (exp, tv) ->
+ ctx_with_local ctx (branch ctx exp tv)
+ | e ->
+ let spawns = ref [] in
+ let splits = ref [] in
+ let sides = ref [] in (* why do we need to collect these instead of calling ctx.sideg directly? *)
+ let assigns = ref [] in
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
+ let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
+ { local = obj d
+ ; node = ctx.node
+ ; prev_node = ctx.prev_node
+ ; control_context = ctx.control_context
+ ; context = (fun () -> ctx.context () |> assoc n |> obj)
+ ; edge = ctx.edge
+ ; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
+ ; presub = filter_presubs n ctx.local
+ ; postsub= filter_presubs n post_all
+ ; global = (fun v -> ctx.global v |> assoc n |> obj)
+ ; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
+ ; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
+ ; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
+ }
+ in
+ let rec octx' : (S.D.t, S.G.t, S.C.t) ctx =
+ { local = obj (assoc n octx.local)
+ ; node = octx.node
+ ; prev_node = octx.prev_node
+ ; control_context = octx.control_context
+ ; context = (fun () -> octx.context () |> assoc n |> obj)
+ ; edge = octx.edge
+ ; ask = query octx
+ ; emit = (fun e -> emits := e :: !emits)
+ ; presub = filter_presubs n octx.local
+ ; postsub= filter_presubs n post_all
+ ; global = (fun v -> octx.global v |> assoc n |> obj)
+ ; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
+ ; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
+ ; assign = (fun ?name v e -> assigns := (v,e,name, repr octx')::!assigns)
+ }
+ in
+ n, repr @@ S.event ctx' e octx'
+ in
+ let d, q = map_deadcode f @@ spec_list ctx.local in
+ if M.tracing then M.tracel "event" "%a\n before: %a\n after:%a\n" Events.pretty e D.pretty ctx.local D.pretty d;
+ do_sideg ctx !sides;
+ do_spawns ctx !spawns;
+ do_splits ctx d !splits;
+ let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
+ if q then raise Deadcode else ctx_with_local ctx d
+ in
+ let ctx' = List.fold_left do_emit (ctx_with_local ctx xs) emits in
+ ctx'.local
+
and branch (ctx:(D.t, G.t, C.t) ctx) (e:exp) (tv:bool) =
let spawns = ref [] in
let splits = ref [] in
let sides = ref [] in (* why do we need to collect these instead of calling ctx.sideg directly? *)
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -430,11 +504,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -446,11 +521,12 @@ struct
do_spawns ctx !spawns;
do_splits ctx d !splits;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
and query (ctx:(D.t, G.t, C.t) ctx) q =
let sides = ref [] in
- let f a (n,(module S:Spec),d) =
+ let f a (n,(module S:MCPSpec),d) =
let ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -459,11 +535,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun _ -> failwith "Cannot \"emit\" in query context.")
; presub = filter_presubs n ctx.local
; postsub= []
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun v d -> failwith "Cannot \"spawn\" in query context.")
- ; split = (fun d e tv -> failwith "Cannot \"split\" in query context.")
+ ; split = (fun d es -> failwith "Cannot \"split\" in query context.")
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name _ -> failwith "Cannot \"assign\" in query context.")
}
@@ -484,7 +561,8 @@ struct
let spawns = ref [] in
let splits = ref [] in
let sides = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -493,11 +571,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name _ -> failwith "Cannot \"assign\" in assign context (cycles?).")
}
@@ -508,6 +587,7 @@ struct
do_sideg ctx !sides;
do_spawns ctx !spawns;
do_splits ctx d !splits;
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
@@ -515,7 +595,8 @@ struct
let spawns = ref [] in
let splits = ref [] in
let sides = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -524,11 +605,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name _ -> failwith "Cannot \"assign\" in assign context (cycles?).")
}
@@ -539,6 +621,7 @@ struct
do_sideg ctx !sides;
do_spawns ctx !spawns;
do_splits ctx d !splits;
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
let body (ctx:(D.t, G.t, C.t) ctx) f =
@@ -546,7 +629,8 @@ struct
let splits = ref [] in
let sides = ref [] in
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -555,11 +639,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -571,6 +656,7 @@ struct
do_spawns ctx !spawns;
do_splits ctx d !splits;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
let return (ctx:(D.t, G.t, C.t) ctx) e f =
@@ -578,7 +664,8 @@ struct
let splits = ref [] in
let sides = ref [] in
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -587,11 +674,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -603,6 +691,7 @@ struct
do_spawns ctx !spawns;
do_splits ctx d !splits;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
let intrpt (ctx:(D.t, G.t, C.t) ctx) =
@@ -610,7 +699,8 @@ struct
let splits = ref [] in
let sides = ref [] in
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -619,11 +709,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -635,6 +726,7 @@ struct
do_spawns ctx !spawns;
do_splits ctx d !splits;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
let asm (ctx:(D.t, G.t, C.t) ctx) =
@@ -642,7 +734,8 @@ struct
let splits = ref [] in
let sides = ref [] in
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -651,11 +744,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -667,6 +761,7 @@ struct
do_spawns ctx !spawns;
do_splits ctx d !splits;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
let skip (ctx:(D.t, G.t, C.t) ctx) =
@@ -674,7 +769,8 @@ struct
let splits = ref [] in
let sides = ref [] in
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -683,11 +779,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -699,6 +796,7 @@ struct
do_spawns ctx !spawns;
do_splits ctx d !splits;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
let special (ctx:(D.t, G.t, C.t) ctx) r f a =
@@ -706,7 +804,8 @@ struct
let splits = ref [] in
let sides = ref [] in
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -715,11 +814,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -731,13 +831,15 @@ struct
do_spawns ctx !spawns;
do_splits ctx d !splits;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
- let sync (ctx:(D.t, G.t, C.t) ctx) =
+ let sync (ctx:(D.t, G.t, C.t) ctx) reason =
let spawns = ref [] in
let splits = ref [] in
let sides = ref [] in
- let f (n,(module S:Spec),d) (dl,cs) =
+ let emits = ref [] in
+ let f (n,(module S:MCPSpec),d) (dl,cs) =
let ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -746,28 +848,30 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= []
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> splits := (n,(repr d,e,tv)) :: !splits)
+ ; split = (fun d es -> splits := (n,(repr d,es)) :: !splits)
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name _ -> failwith "Cannot \"assign\" in sync context.")
}
in
- let d, ds = S.sync ctx' in
+ let d, ds = S.sync ctx' reason in
(n, repr d)::dl, (map (fun (v,d) -> v, (n,repr d)::(remove_assoc n @@ G.bot ())) ds) @ cs
in
let d,cs = fold_right f (spec_list ctx.local) ([],[]) in
do_sideg ctx !sides;
do_spawns ctx !spawns;
do_splits ctx d !splits;
+ let d = do_emits ctx !emits d in
d, cs
let enter (ctx:(D.t, G.t, C.t) ctx) r f a =
let spawns = ref [] in
let sides = ref [] in
- let f (n,(module S:Spec),d) =
+ let f (n,(module S:MCPSpec),d) =
let ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -776,6 +880,7 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun _ -> failwith "Cannot \"emit\" in enter context.")
; presub = filter_presubs n ctx.local
; postsub= []
; global = (fun v -> ctx.global v |> assoc n |> obj)
@@ -796,7 +901,8 @@ struct
let spawns = ref [] in
let sides = ref [] in
let assigns = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let rec ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -805,11 +911,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun l v a -> spawns := (v,(n,l,a)) :: !spawns)
- ; split = (fun d e tv -> failwith "Cannot \"split\" in combine context.")
+ ; split = (fun d es -> failwith "Cannot \"split\" in combine context.")
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> assigns := (v,e,name, repr ctx')::!assigns)
}
@@ -820,11 +927,13 @@ struct
do_sideg ctx !sides;
do_spawns ctx !spawns;
let d = do_assigns ctx !assigns d in
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
let threadenter (ctx:(D.t, G.t, C.t) ctx) lval f a =
let sides = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f (n,(module S:MCPSpec),d) =
let ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -833,24 +942,27 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
- ; postsub= filter_presubs n post_all
+ ; postsub= []
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun v d -> failwith "Cannot \"spawn\" in threadenter context.")
- ; split = (fun d e tv -> failwith "Cannot \"split\" in threadenter context.")
+ ; split = (fun d es -> failwith "Cannot \"split\" in threadenter context.")
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> failwith "Cannot \"assign\" in threadenter context.")
}
in
- n, repr @@ S.threadenter ctx' lval f a
+ map (fun d -> (n, repr d)) @@ S.threadenter ctx' lval f a
in
- let d, q = map_deadcode f @@ spec_list ctx.local in
+ let css = map f @@ spec_list ctx.local in
do_sideg ctx !sides;
- if q then raise Deadcode else d
+ (* TODO: this do_emits is now different from everything else *)
+ map (do_emits ctx !emits) @@ map topo_sort_an @@ n_cartesian_product css
let threadspawn (ctx:(D.t, G.t, C.t) ctx) lval f a fctx =
let sides = ref [] in
- let f post_all (n,(module S:Spec),d) =
+ let emits = ref [] in
+ let f post_all (n,(module S:MCPSpec),d) =
let ctx' : (S.D.t, S.G.t, S.C.t) ctx =
{ local = obj d
; node = ctx.node
@@ -859,11 +971,12 @@ struct
; context = (fun () -> ctx.context () |> assoc n |> obj)
; edge = ctx.edge
; ask = query ctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n ctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> ctx.global v |> assoc n |> obj)
; spawn = (fun v d -> failwith "Cannot \"spawn\" in threadspawn context.")
- ; split = (fun d e tv -> failwith "Cannot \"split\" in threadspawn context.")
+ ; split = (fun d es -> failwith "Cannot \"split\" in threadspawn context.")
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> failwith "Cannot \"assign\" in threadspawn context.")
}
@@ -876,11 +989,12 @@ struct
; context = (fun () -> fctx.context () |> assoc n |> obj)
; edge = fctx.edge
; ask = query fctx
+ ; emit = (fun e -> emits := e :: !emits)
; presub = filter_presubs n fctx.local
; postsub= filter_presubs n post_all
; global = (fun v -> fctx.global v |> assoc n |> obj)
; spawn = (fun v d -> failwith "Cannot \"spawn\" in threadspawn context.")
- ; split = (fun d e tv -> failwith "Cannot \"split\" in threadspawn context.")
+ ; split = (fun d es -> failwith "Cannot \"split\" in threadspawn context.")
; sideg = (fun v g -> sides := (v, (n, repr g)) :: !sides)
; assign = (fun ?name v e -> failwith "Cannot \"assign\" in threadspawn context.")
}
@@ -889,5 +1003,6 @@ struct
in
let d, q = map_deadcode f @@ spec_list ctx.local in
do_sideg ctx !sides;
+ let d = do_emits ctx !emits d in
if q then raise Deadcode else d
end
diff --git a/src/analyses/mallocWrapperAnalysis.ml b/src/analyses/mallocWrapperAnalysis.ml
index 7de5c596bb..f5bdc54377 100644
--- a/src/analyses/mallocWrapperAnalysis.ml
+++ b/src/analyses/mallocWrapperAnalysis.ml
@@ -4,7 +4,7 @@ open Prelude.Ana
open Analyses
open GobConfig
-module Spec : Analyses.Spec =
+module Spec : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
@@ -51,8 +51,8 @@ struct
ctx.local
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
let heap_hash = Hashtbl.create 113
@@ -85,4 +85,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml
index 4395eaf1a3..5c2c68fcbe 100644
--- a/src/analyses/malloc_null.ml
+++ b/src/analyses/malloc_null.ml
@@ -1,6 +1,5 @@
(** Path-sensitive analysis that verifies checking the result of the malloc function. *)
-module BS = Base.Main
module AD = ValueDomain.AD
module IdxDom = ValueDomain.IndexDomain
module Offs = ValueDomain.Offs
@@ -216,8 +215,8 @@ struct
begin
match get_concrete_lval ctx.ask lv with
| Some (Var v, offs) ->
- ctx.split ctx.local (Lval lv) true;
- ctx.split (D.add (Addr.from_var_offset (v,offs)) ctx.local) (Lval lv) false;
+ ctx.split ctx.local [Events.SplitBranch ((Lval lv), true)];
+ ctx.split (D.add (Addr.from_var_offset (v,offs)) ctx.local) [Events.SplitBranch ((Lval lv), false)];
raise Analyses.Deadcode
| _ -> ctx.local
end
@@ -226,8 +225,8 @@ struct
let name () = "malloc_null"
let startstate v = D.empty ()
- let threadenter ctx lval f args = D.empty ()
- let threadspawn ctx lval f args fctx = D.empty ()
+ let threadenter ctx lval f args = [D.empty ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.empty ()
let init () =
@@ -236,4 +235,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml
index 04790a241e..1abd83e4db 100644
--- a/src/analyses/mayLocks.ml
+++ b/src/analyses/mayLocks.ml
@@ -44,8 +44,8 @@ struct
match lv with
| None -> nls
| Some lv ->
- ctx.split nls (Lval lv) return_value_on_success;
- if may_fail then ctx.split ls (Lval lv) (not return_value_on_success);
+ ctx.split nls [Events.SplitBranch (Lval lv, return_value_on_success)];
+ if may_fail then ctx.split ls [Events.SplitBranch (Lval lv, not return_value_on_success)];
raise Analyses.Deadcode
(* transfer function to handle library functions --- for us locking & unlocking *)
@@ -69,10 +69,10 @@ struct
| _ -> ctx.local
let startstate v = D.empty ()
- let threadenter ctx lval f args = D.empty ()
- let threadspawn ctx lval f args fctx = D.empty ()
+ let threadenter ctx lval f args = [D.empty ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml
index 00d5db753d..9dc18c217d 100644
--- a/src/analyses/mutexAnalysis.ml
+++ b/src/analyses/mutexAnalysis.ml
@@ -12,18 +12,11 @@ module IdxDom = ValueDomain.IndexDomain
module LockingPattern = Exp.LockingPattern
module Exp = Exp.Exp
(*module BS = Base.Spec*)
-module BS = Base.Main
module LF = LibraryFunctions
open Prelude.Ana
open Analyses
open GobConfig
-(** only report write races *)
-let no_read = ref false
-
-(** Only report races on these variables/types. *)
-let vips = ref ([]: string list)
-
let big_kernel_lock = LockDomain.Addr.from_var (Goblintutil.create_var (makeGlobalVar "[big kernel lock]" intType))
let console_sem = LockDomain.Addr.from_var (Goblintutil.create_var (makeGlobalVar "[console semaphore]" intType))
let verifier_atomic = LockDomain.Addr.from_var (Goblintutil.create_var (makeGlobalVar "[__VERIFIER_atomic]" intType))
@@ -31,8 +24,8 @@ let verifier_atomic = LockDomain.Addr.from_var (Goblintutil.create_var (makeGlob
module type SpecParam =
sig
module G: Lattice.S
- val effect_fun: Lockset.t -> G.t
- val check_fun: Lockset.t -> G.t
+ val effect_fun: ?write:bool -> Lockset.t -> G.t
+ val check_fun: ?write:bool -> Lockset.t -> G.t
end
(** Data race analyzer without base --- this is the new standard *)
@@ -61,6 +54,12 @@ struct
| `Index (_,o) -> `Index (ValueDomain.IndexDomain.top (), conv_offset o)
| `Field (f,o) -> `Field (f, conv_offset o)
+ let rec conv_offset_inv = function
+ | `NoOffset -> `NoOffset
+ | `Field (f, o) -> `Field (f, conv_offset_inv o)
+ (* TODO: better indices handling *)
+ | `Index (_, o) -> `Index (MyCFG.unknown_exp, conv_offset_inv o)
+
let rec conv_const_offset x =
match x with
| NoOffset -> `NoOffset
@@ -82,7 +81,7 @@ struct
| Some v ->
if not (Lockset.is_bot ctx.local) then
let ls = Lockset.filter snd ctx.local in
- let el = P.effect_fun ls in
+ let el = P.effect_fun ~write:w ls in
ctx.sideg v el
| None -> M.warn "Write to unknown address: privatization is unsound."
end;
@@ -124,12 +123,18 @@ struct
else begin
let nls = Lockset.add (e,rw) ls in
match lv with
- | None -> if may_fail then ls else nls
+ | None ->
+ if may_fail then
+ ls
+ else (
+ ctx.emit (Events.Lock e);
+ nls
+ )
| Some lv ->
- ctx.split nls (Lval lv) nonzero_return_when_aquired;
+ ctx.split nls [Events.SplitBranch (Lval lv, nonzero_return_when_aquired); Events.Lock e];
if may_fail then (
let fail_exp = if nonzero_return_when_aquired then Lval lv else BinOp(Gt, Lval lv, zero, intType) in
- ctx.split ls fail_exp (not nonzero_return_when_aquired)
+ ctx.split ls [Events.SplitBranch (fail_exp, not nonzero_return_when_aquired)]
);
raise Analyses.Deadcode
end
@@ -210,9 +215,9 @@ struct
| _ ->
add_access (conf - 60) None None
- let access_one_top ctx write reach exp =
+ let access_one_top ?(force=false) ctx write reach exp =
(* ignore (Pretty.printf "access_one_top %b %b %a:\n" write reach d_exp exp); *)
- if ThreadFlag.is_multi ctx.ask then (
+ if force || ThreadFlag.is_multi ctx.ask then (
let conf = 110 in
if reach || write then do_access ctx write reach conf exp;
Access.distribute_access_exp (do_access ctx) false false conf exp;
@@ -220,8 +225,7 @@ struct
(** We just lift start state, global and dependency functions: *)
let startstate v = Lockset.empty ()
- let threadenter ctx lval f args = Lockset.empty ()
- let threadspawn ctx lval f args fctx = Lockset.empty ()
+ let threadenter ctx lval f args = [Lockset.empty ()]
let exitstate v = Lockset.empty ()
let query ctx (q:Queries.t) : Queries.Result.t =
@@ -232,20 +236,36 @@ struct
in
match q with
| Queries.MayBePublic _ when Lockset.is_bot ctx.local -> `MayBool false
- | Queries.MayBePublic v ->
- let held_locks: G.t = P.check_fun (Lockset.filter snd ctx.local) in
+ | Queries.MayBePublic {global=v; write} ->
+ let held_locks: G.t = P.check_fun ~write (Lockset.filter snd ctx.local) in
if Mutexes.mem verifier_atomic (Lockset.export_locks ctx.local) then `MayBool false
else non_overlapping held_locks (ctx.global v)
+ | Queries.MayBePublicWithout _ when Lockset.is_bot ctx.local -> `MayBool false
+ | Queries.MayBePublicWithout {global=v; write; without_mutex} ->
+ let held_locks: G.t = P.check_fun ~write (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in
+ if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) ctx.local)) then `MayBool false
+ else non_overlapping held_locks (ctx.global v)
+ | Queries.MustBeProtectedBy {mutex; global; write} ->
+ let mutex_lockset = Lockset.singleton (mutex, true) in
+ let held_locks: G.t = P.check_fun ~write mutex_lockset in
+ if LockDomain.Addr.equal mutex verifier_atomic then `MustBool true
+ else `MustBool (G.leq (ctx.global global) held_locks)
+ | Queries.CurrentLockset ->
+ let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in
+ let ls = Mutexes.fold (fun addr ls ->
+ match Addr.to_var_offset addr with
+ | [(var, offs)] -> Queries.LS.add (var, conv_offset_inv offs) ls
+ | _ -> ls
+ ) held_locks (Queries.LS.empty ())
+ in
+ `LvalSet ls
+ | Queries.MustBeAtomic ->
+ let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in
+ `MustBool (Mutexes.mem verifier_atomic held_locks)
| Queries.PartAccess {exp; var_opt; write} ->
`PartAccessResult (part_access ctx exp var_opt write)
| _ -> Queries.Result.top ()
- let may_race (ctx1,ac1) (ctx,ac2) =
- let write = function `Lval (_,b) | `Reach (_,b) -> b in
- let prot_locks b ls = if b then D.filter snd ls else D.map (fun (x,_) -> (x,true)) ls in
- let ls1 = prot_locks (write ac1) ctx1.local in
- let ls2 = prot_locks (write ac2) ctx.local in
- Lockset.is_empty (Lockset.ReverseAddrSet.inter ls1 ls2)
(** Transfer functions: *)
@@ -267,20 +287,27 @@ struct
| None -> ()
end;
(* deprecated but still valid SV-COMP convention for atomic block *)
- if get_bool "ana.sv-comp.functions" && String.starts_with fundec.svar.vname "__VERIFIER_atomic_" then
+ if get_bool "ana.sv-comp.functions" && String.starts_with fundec.svar.vname "__VERIFIER_atomic_" then (
+ ctx.emit (Events.Unlock verifier_atomic);
Lockset.remove (verifier_atomic, true) ctx.local
+ )
else
ctx.local
let body ctx f : D.t =
(* deprecated but still valid SV-COMP convention for atomic block *)
- if get_bool "ana.sv-comp.functions" && String.starts_with f.svar.vname "__VERIFIER_atomic_" then
+ if get_bool "ana.sv-comp.functions" && String.starts_with f.svar.vname "__VERIFIER_atomic_" then (
+ ctx.emit (Events.Lock verifier_atomic);
Lockset.add (verifier_atomic, true) ctx.local
+ )
else
ctx.local
let special ctx lv f arglist : D.t =
- let remove_rw x st = Lockset.remove (x,true) (Lockset.remove (x,false) st) in
+ let remove_rw x st =
+ ctx.emit (Events.Unlock x);
+ Lockset.remove (x,true) (Lockset.remove (x,false) st)
+ in
let unlock remove_fn =
let remove_nonspecial x =
if Lockset.is_top x then x else
@@ -297,10 +324,12 @@ struct
| _ -> ctx.local
in
match (LF.classify f.vname arglist, f.vname) with
- | _, "_lock_kernel"
- -> Lockset.add (big_kernel_lock,true) ctx.local
- | _, "_unlock_kernel"
- -> Lockset.remove (big_kernel_lock,true) ctx.local
+ | _, "_lock_kernel" ->
+ ctx.emit (Events.Lock big_kernel_lock);
+ Lockset.add (big_kernel_lock,true) ctx.local
+ | _, "_unlock_kernel" ->
+ ctx.emit (Events.Unlock big_kernel_lock);
+ Lockset.remove (big_kernel_lock,true) ctx.local
| `Lock (failing, rw, nonzero_return_when_aquired), _
-> let arglist = if f.vname = "LAP_Se_WaitSemaphore" then [List.hd arglist] else arglist in
(*print_endline @@ "Mutex `Lock "^f.vname;*)
@@ -325,14 +354,18 @@ struct
unlock remove_rw
| _, "spinlock_check" -> ctx.local
| _, "acquire_console_sem" when get_bool "kernel" ->
+ ctx.emit (Events.Lock console_sem);
Lockset.add (console_sem,true) ctx.local
| _, "release_console_sem" when get_bool "kernel" ->
+ ctx.emit (Events.Unlock console_sem);
Lockset.remove (console_sem,true) ctx.local
| _, "__builtin_prefetch" | _, "misc_deregister" ->
ctx.local
| _, "__VERIFIER_atomic_begin" when get_bool "ana.sv-comp.functions" ->
+ ctx.emit (Events.Lock verifier_atomic);
Lockset.add (verifier_atomic, true) ctx.local
| _, "__VERIFIER_atomic_end" when get_bool "ana.sv-comp.functions" ->
+ ctx.emit (Events.Unlock verifier_atomic);
Lockset.remove (verifier_atomic, true) ctx.local
| _, x ->
let arg_acc act =
@@ -359,6 +392,15 @@ struct
List.iter (access_one_top ctx false false) args;
al
+
+ let threadspawn ctx lval f args fctx =
+ (* must explicitly access thread ID lval because special to pthread_create doesn't if singlethreaded before *)
+ begin match lval with
+ | None -> ()
+ | Some lval -> access_one_top ~force:true ctx true false (AddrOf lval) (* must force because otherwise doesn't if singlethreaded before *)
+ end;
+ ctx.local
+
let init () =
init ();
arinc_analysis_activated := List.exists (fun x -> Json.string x="arinc") (get_list "ana.activated")
@@ -368,11 +410,32 @@ end
module MyParam =
struct
module G = LockDomain.Simple
- let effect_fun ls = Lockset.export_locks ls
+ let effect_fun ?write:(w=false) ls = Lockset.export_locks ls
let check_fun = effect_fun
end
-module Spec = MakeSpec (MyParam)
+module WriteBased =
+struct
+ module GReadWrite =
+ struct
+ include LockDomain.Simple
+ let name () = "readwrite"
+ end
+ module GWrite =
+ struct
+ include LockDomain.Simple
+ let name () = "write"
+ end
+ module G = Lattice.Prod (GReadWrite) (GWrite)
+ let effect_fun ?write:(w=false) ls =
+ let locks = Lockset.export_locks ls in
+ (locks, if w then locks else Mutexes.top ())
+ let check_fun ?write:(w=false) ls =
+ let locks = Lockset.export_locks ls in
+ if w then (Mutexes.bot (), locks) else (locks, Mutexes.bot ())
+end
+
+module Spec = MakeSpec (WriteBased)
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/octagon.ml b/src/analyses/octagon.ml
index ae5b93f702..fbae4468b7 100644
--- a/src/analyses/octagon.ml
+++ b/src/analyses/octagon.ml
@@ -12,7 +12,7 @@ let stripCastsDeep e =
end
in visitCilExpr v e
-module Spec : Analyses.Spec =
+module Spec : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
let name () = "octagon"
@@ -300,7 +300,7 @@ struct
| Some (Mem _, _)
| None -> ctx.local
let startstate v = D.top ()
- let threadenter ctx lval f args = D.top ()
+ let threadenter ctx lval f args = [D.top ()]
let exitstate v = D.top ()
let query ctx q =
@@ -371,9 +371,9 @@ struct
else `Top
| _ -> Queries.Result.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadspawn ctx lval f args fctx = ctx.local
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/osek.ml b/src/analyses/osek.ml
index 9171bcf6ca..c32b953219 100644
--- a/src/analyses/osek.ml
+++ b/src/analyses/osek.ml
@@ -226,7 +226,7 @@ struct
module MyParam =
struct
module G = LockDomain.Priorities
- let effect_fun (ls: LockDomain.Lockset.t) =
+ let effect_fun ?write:(w=false) (ls: LockDomain.Lockset.t) =
let locks = LockDomain.Lockset.ReverseAddrSet.elements ls in
let prys = List.map names locks in
let staticprys = List.filter is_task_res prys in
@@ -423,7 +423,7 @@ struct
let add_concrete_access ctx fl loc ust (flagstate : Flags.t) (v, o, rv: Cil.varinfo * Offs.t * bool) =
let ign_flag_filter acc tuple = not (AccLoc.equal acc (proj2_1 tuple)) in
let remove_acc acc set = AccValSet.filter (ign_flag_filter acc) set in
- if (Base.is_global ctx.ask v) then begin
+ if (BaseUtil.is_global ctx.ask v) then begin
if not (is_task v.vname) || flagstate = Flags.top() then begin
if !GU.should_warn then begin
let new_acc = ((loc,fl,rv),ust,o) in
@@ -571,7 +571,7 @@ struct
let pry = resourceset_to_priority (List.map names (Mutex.Lockset.ReverseAddrSet.elements ctx.local)) in
`Int (Int64.of_int pry)
| Queries.Priority vname -> begin try `Int (Int64.of_int (Hashtbl.find offensivepriorities vname) ) with _ -> Queries.Result.top() end
- | Queries.MayBePublic v ->
+ | Queries.MayBePublic {global=v; _} ->
let pry = resourceset_to_priority (List.map names (Mutex.Lockset.ReverseAddrSet.elements ctx.local)) in
if pry = min_int then
`MayBool false
@@ -587,6 +587,9 @@ struct
(* offpry_flags flagstate v *)
(* end *)
in `MayBool (off > pry)
+ | Queries.CurrentLockset -> (* delegate for MinePriv *)
+ (* TODO: delegate other queries? *)
+ M.query ctx q
| _ -> Queries.Result.top ()
let rec conv_offset x =
@@ -710,8 +713,8 @@ struct
let startstate v = D.top ()
let exitstate v = D.top ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let activate_task ctx (task_name : string) : unit =
let task = Cilfacade.getFun task_name in
@@ -1260,8 +1263,7 @@ struct
if !suppressed > 1 then
print_endline ("However " ^ (string_of_int !suppressed) ^ " warnings have been suppressed.");
if !filtered > 0 then
- print_endline ("Filtering of safe tasks/irpts was used " ^ (string_of_int !filtered) ^ " time(s).");
- Base.Main.finalize ()
+ print_endline ("Filtering of safe tasks/irpts was used " ^ (string_of_int !filtered) ^ " time(s).")
let init () = (*
let tramp = get_string "ana.osek.tramp" in
@@ -1283,4 +1285,4 @@ struct
end;
end
-let () = MCP.register_analysis ~dep:["base";"threadid";"threadflag";"fmode"] (module Spec : Spec)
+let () = MCP.register_analysis ~dep:["base";"threadid";"threadflag";"fmode"] (module Spec : MCPSpec)
diff --git a/src/analyses/osektransactionality.ml b/src/analyses/osektransactionality.ml
index 26ed034a45..4ddcca0ed6 100644
--- a/src/analyses/osektransactionality.ml
+++ b/src/analyses/osektransactionality.ml
@@ -114,8 +114,8 @@ struct
(ctxs, ctxr)
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
(** Finalization and other result printing functions: *)
@@ -167,12 +167,11 @@ struct
(* let _ = print_endline ( "Finalize trans") in *)
let _ = Hashtbl.iter report_trans funs in
if !transactional then
- print_endline "Goblint did not find any non-transactional behavior in this program!";
- Base.Main.finalize ()
+ print_endline "Goblint did not find any non-transactional behavior in this program!"
let init () = ()
end
let _ =
- MCP.register_analysis ~dep:["OSEK"; "stack_trace_set"] (module Spec : Spec)
+ MCP.register_analysis ~dep:["OSEK"; "stack_trace_set"] (module Spec : MCPSpec)
diff --git a/src/analyses/poly.ml b/src/analyses/poly.ml
index 9c6c7e36b0..c2af61d067 100644
--- a/src/analyses/poly.ml
+++ b/src/analyses/poly.ml
@@ -20,7 +20,7 @@ struct
let context x = if GobConfig.get_bool "exp.full-context" then x else D.bot ()
let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate _ = D.top ()
let startstate _ = D.top ()
diff --git a/src/analyses/region.ml b/src/analyses/region.ml
index 621448a56e..b71db73294 100644
--- a/src/analyses/region.ml
+++ b/src/analyses/region.ml
@@ -6,7 +6,6 @@ open Analyses
module RegMap = RegionDomain.RegMap
module RegPart = RegionDomain.RegPart
module Reg = RegionDomain.Reg
-module BS = Base.Main
module Spec =
struct
@@ -105,7 +104,9 @@ struct
| `Lifted reg ->
let old_regpart = get_regpart ctx in
let regpart, reg = match exp with
- | Some exp -> Reg.assign (BS.return_lval ()) exp (old_regpart, reg)
+ | Some exp ->
+ let module BS = (val Base.get_main ()) in
+ Reg.assign (BS.return_lval ()) exp (old_regpart, reg)
| None -> (old_regpart, reg)
in
let regpart, reg = Reg.kill_vars locals (Reg.remove_vars locals (regpart, reg)) in
@@ -136,6 +137,7 @@ struct
match au with
| `Lifted reg -> begin
let old_regpart = get_regpart ctx in
+ let module BS = (val Base.get_main ()) in
let regpart, reg = match lval with
| None -> (old_regpart, reg)
| Some lval -> Reg.assign lval (AddrOf (BS.return_lval ())) (old_regpart, reg)
@@ -173,8 +175,8 @@ struct
`Lifted (RegMap.bot ())
let threadenter ctx lval f args =
- `Lifted (RegMap.bot ())
- let threadspawn ctx lval f args fctx = D.bot ()
+ [`Lifted (RegMap.bot ())]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = `Lifted (RegMap.bot ())
@@ -186,4 +188,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/shapes.ml b/src/analyses/shapes.ml
index 637930ebd7..ec41782d86 100644
--- a/src/analyses/shapes.ml
+++ b/src/analyses/shapes.ml
@@ -65,13 +65,13 @@ struct
let ge v = let a,b = ctx.global v in b in
let spawn f v x = f v x in
let geffect f v d = f v (false, d) in
- let split f d e t = f (LD.singleton (SHMap.top ()), d) e t in
+ let split f d es = f (LD.singleton (SHMap.top ()), d) es in
set_st_gl ctx re ge spawn geffect split
let threadenter ctx lval f args =
let st, re = ctx.local in
- (LD.singleton (SHMap.top ()), Re.threadenter (re_context ctx re) lval f args)
- let threadspawn ctx lval f args fctx = D.bot ()
+ Re.threadenter (re_context ctx re) lval f args |> List.map (fun d -> (LD.singleton (SHMap.top ()), d))
+ let threadspawn ctx lval f args fctx = ctx.local
let sync_ld ask gl upd st =
let f sm (st, ds, rm, part)=
@@ -106,12 +106,12 @@ struct
- let sync ctx : D.t * (varinfo*G.t) list =
+ let sync ctx reason : D.t * (varinfo*G.t) list =
let st, re = ctx.local in
let gl v = let a,b = ctx.global v in a in
let upd v d = ctx.sideg v (d,Re.G.bot ()) in
let nst, dst, rm, part = tryReallyHard ctx.ask gl upd (sync_ld ctx.ask gl upd) st in
- let nre, dre = Re.sync (re_context ctx re) in
+ let nre, dre = Re.sync (re_context ctx re) reason in
let update k v m =
let old = try RegMap.find k m with Not_found -> RS.empty () in
if (not (RS.is_top old)) && RS.for_all (function (`Left (v,_)) -> not (gl v) | `Right _ -> true) old
@@ -127,7 +127,7 @@ struct
match nre with
| `Lifted m ->
let alive =
- match MyLiveness.getLiveSet !Cilfacade.currentStatement.sid with
+ match MyLiveness.getLiveSet !Cilfacade.current_statement.sid with
| Some x -> x
| _ -> Usedef.VS.empty
in
@@ -266,7 +266,7 @@ struct
let upd v d = ctx.sideg v (d,Re.G.bot ()) in
let s1 = tryReallyHard ctx.ask gl upd (special_fn_ld ctx.ask gl upd lval f arglist) st in
let s2 = Re.special (re_context ctx re) lval f arglist in
- List.iter (fun (x,y,z) -> ctx.split (x,s2) y z) s1;
+ List.iter (fun (x,y,z) -> ctx.split (x,s2) [Events.SplitBranch (y, z)]) s1;
raise Analyses.Deadcode
let query ctx (q:Queries.t) : Queries.Result.t =
@@ -283,4 +283,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml
index c254634959..f6536afea3 100644
--- a/src/analyses/spec.ml
+++ b/src/analyses/spec.ml
@@ -184,7 +184,7 @@ struct
let c_exp = Formatcil.cExp c_str [("key", Fe (D.K.to_exp var))] in (* use Fl for Lval instead? *)
(* TODO encode key in exp somehow *)
(* ignore(printf "BRANCH %a\n" d_plainexp c_exp); *)
- ctx.split new_m c_exp true;
+ ctx.split new_m [Events.SplitBranch (c_exp, true)];
Set.add (new_m,c_exp,true) (Set.add (new_m,c_exp,false) branches)
in
List.fold_left do_branch branches branch_edges
@@ -464,7 +464,7 @@ struct
(* let _ = M.debug @@ vvar.vname^" was a global -> alias" in *)
D.alias k vvar au
else (* returned variable was a local *)
- let v = D.V.set_key k v in (* ajust var-field to lval *)
+ let v = D.V.set_key k v in (* adjust var-field to lval *)
(* M.debug @@ vvar.vname^" was a local -> rebind"; *)
D.add' k v au
| _ -> au
@@ -511,10 +511,10 @@ struct
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.bot ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.bot ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/stackTrace.ml b/src/analyses/stackTrace.ml
index 17ceddc965..a631702a09 100644
--- a/src/analyses/stackTrace.ml
+++ b/src/analyses/stackTrace.ml
@@ -36,8 +36,8 @@ struct
ctx.local
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.bot ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
end
@@ -77,15 +77,15 @@ struct
let exitstate v = D.top ()
let threadenter ctx lval f args =
- D.push !Tracing.current_loc ctx.local
+ [D.push !Tracing.current_loc ctx.local]
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadspawn ctx lval f args fctx = ctx.local
end
module Spec1 = Spec (StackDomain.Dom1) (struct let name = "stack_trace" end)
module Spec2 = Spec (StackDomain.Dom2) (struct let name = "stack_trace_set" end)
let _ =
- MCP.register_analysis (module SpecLoc : Spec);
- MCP.register_analysis (module Spec1 : Spec);
- MCP.register_analysis (module Spec2 : Spec)
+ MCP.register_analysis (module SpecLoc : MCPSpec);
+ MCP.register_analysis (module Spec1 : MCPSpec);
+ MCP.register_analysis (module Spec2 : MCPSpec)
diff --git a/src/analyses/symbLocks.ml b/src/analyses/symbLocks.ml
index 5a3aae3f5c..da5770bfe6 100644
--- a/src/analyses/symbLocks.ml
+++ b/src/analyses/symbLocks.ml
@@ -23,8 +23,8 @@ struct
let name () = "symb_locks"
let startstate v = D.top ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
let branch ctx exp tv = ctx.local
@@ -145,23 +145,6 @@ struct
| _ ->
ust
- let may_race (ctx1,ac1) (ctx,ac2) =
- match ac1, ac2 with
- | `Lval (l1,r1), `Lval (l2,r2) ->
- let ls1 = get_all_locks ctx1.ask (Lval l1) ctx1.local in
- let ls1 = Queries.PS.fold (one_perelem ctx1.ask) ls1 (ExpSet.empty) in
- let ls2 = get_all_locks ctx.ask (Lval l2) ctx.local in
- let ls2 = Queries.PS.fold (one_perelem ctx.ask) ls2 (ExpSet.empty) in
- (*ignore (Pretty.printf "{%a} inter {%a} = {%a}\n" (Pretty.d_list ", " Exp.pretty) (ExpSet.elements ls1) (Pretty.d_list ", " Exp.pretty) (ExpSet.elements ls2) (Pretty.d_list ", " Exp.pretty) (ExpSet.elements (ExpSet.inter ls1 ls2)));*)
- ExpSet.is_empty (ExpSet.inter ls1 ls2) &&
- let ls1 = same_unknown_index ctx1.ask (Lval l1) ctx1.local in
- let ls1 = Queries.PS.fold one_lockstep ls1 (LockDomain.Lockset.empty ()) in
- let ls2 = same_unknown_index ctx.ask (Lval l2) ctx.local in
- let ls2 = Queries.PS.fold one_lockstep ls2 (LockDomain.Lockset.empty ()) in
- LockDomain.Lockset.is_empty (LockDomain.Lockset.ReverseAddrSet.inter ls1 ls2)
-
- | _ -> true
-
let add_per_element_access ctx e rw =
let module LSSet = Access.LSSet in
(* Per-element returns a triple of exps, first are the "element" pointers,
@@ -244,4 +227,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/termination.ml b/src/analyses/termination.ml
index 7958cac4ae..e9efde1287 100644
--- a/src/analyses/termination.ml
+++ b/src/analyses/termination.ml
@@ -229,8 +229,8 @@ struct
ctx.local
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.bot ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.bot ()
end
@@ -249,4 +249,4 @@ let _ =
Cilfacade.register_preprocess (Spec.name ()) (new recomputeVisitor);
Hashtbl.clear loopBreaks; (* because the sids are now different *)
Cilfacade.register_preprocess (Spec.name ()) (new loopBreaksVisitor);
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/threadAnalysis.ml b/src/analyses/threadAnalysis.ml
index 0dce3fc38b..39648aae9e 100644
--- a/src/analyses/threadAnalysis.ml
+++ b/src/analyses/threadAnalysis.ml
@@ -15,6 +15,8 @@ struct
module C = D
module G = ConcDomain.ThreadCreation
+ let should_join = D.equal
+
(* transfer functions *)
let assign ctx (lval:lval) (rval:exp) : D.t = ctx.local
let branch ctx (exp:exp) (tv:bool) : D.t = ctx.local
@@ -88,7 +90,7 @@ struct
| _ -> Queries.Result.top ()
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.bot ()
+ let threadenter ctx lval f args = [D.bot ()]
let threadspawn ctx lval f args fctx =
let creator = ThreadId.get_current ctx.ask in
let tid = ThreadId.get_current_unlift fctx.ask in
@@ -100,7 +102,7 @@ struct
| `Bot -> (false, TS.bot (), false)
in
ctx.sideg tid eff;
- D.singleton tid
+ D.join ctx.local (D.singleton tid)
let exitstate v = D.bot ()
end
@@ -129,10 +131,10 @@ struct
let threadenter ctx lval f args =
let location x = let l = !Tracing.current_loc in l.file ^ ":" ^ string_of_int l.line ^ ":" ^ x.vname in
- D.singleton (location f)
+ [D.singleton (location f)]
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadspawn ctx lval f args fctx = ctx.local
end
-let _ = MCP.register_analysis (module StartLocIDs : Spec)
-let _ = MCP.register_analysis ~dep:["threadid"] (module Spec : Spec)
+let _ = MCP.register_analysis (module StartLocIDs : MCPSpec)
+let _ = MCP.register_analysis ~dep:["threadid"] (module Spec : MCPSpec)
diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml
index 1568cf6813..95f6787933 100644
--- a/src/analyses/threadEscape.ml
+++ b/src/analyses/threadEscape.ml
@@ -75,14 +75,23 @@ struct
let threadenter ctx lval f args =
match args with
- | [ptc_arg] -> reachable ctx.ask ptc_arg
- | _ -> D.bot ()
+ | [ptc_arg] ->
+ let escaped = reachable ctx.ask ptc_arg in
+ if not (D.is_empty escaped) then (* avoid emitting unnecessary event *)
+ ctx.emit (Events.Escape escaped);
+ [escaped]
+ | _ -> [D.bot ()]
let threadspawn ctx lval f args fctx =
- match args with
- | [ptc_arg] -> reachable ctx.ask ptc_arg (* TODO: just use fd? *)
- | _ -> D.bot ()
+ D.join ctx.local @@
+ match args with
+ | [ptc_arg] ->
+ let escaped = fctx.local in (* reuse reachable computation from threadenter *)
+ if not (D.is_empty escaped) then (* avoid emitting unnecessary event *)
+ ctx.emit (Events.Escape escaped);
+ escaped
+ | _ -> D.bot ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml
index 953e88049b..bed337d1fb 100644
--- a/src/analyses/threadFlag.ml
+++ b/src/analyses/threadFlag.ml
@@ -33,6 +33,8 @@ struct
let create_tid v =
Flag.get_multi ()
+ let should_join = D.equal
+
let body ctx f = ctx.local
let branch ctx exp tv = ctx.local
@@ -78,11 +80,15 @@ struct
| _ -> `Top
let threadenter ctx lval f args =
- create_tid f
+ if not (is_multi ctx.ask) then
+ ctx.emit Events.EnterMultiThreaded;
+ [create_tid f]
let threadspawn ctx lval f args fctx =
- Flag.get_main ()
+ if not (is_multi ctx.ask) then
+ ctx.emit Events.EnterMultiThreaded;
+ D.join ctx.local (Flag.get_main ())
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml
index 3f8b29cf73..513075776b 100644
--- a/src/analyses/threadId.ml
+++ b/src/analyses/threadId.ml
@@ -86,11 +86,11 @@ struct
| _ -> `Top
let threadenter ctx lval f args =
- create_tid f
+ [create_tid f]
let threadspawn ctx lval f args fctx =
- ThreadLifted.bot ()
+ ctx.local
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/threadReturn.ml b/src/analyses/threadReturn.ml
index 90fe1e20c7..9f387d4ece 100644
--- a/src/analyses/threadReturn.ml
+++ b/src/analyses/threadReturn.ml
@@ -10,7 +10,7 @@ let is_current (ask: Queries.ask): bool =
| _ -> failwith "ThreadReturn.is_current"
-module Spec : Analyses.Spec =
+module Spec : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
@@ -42,8 +42,8 @@ struct
ctx.local
let startstate v = true
- let threadenter ctx lval f args = true
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [true]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
let query ctx x =
@@ -53,4 +53,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml
index c075dfe798..b9b7d86d38 100644
--- a/src/analyses/uninit.ml
+++ b/src/analyses/uninit.ml
@@ -1,7 +1,6 @@
(** Local variable initialization analysis. *)
module M = Messages
-module BS = Base.Main
module AD = ValueDomain.AD
module IdxDom = ValueDomain.IndexDomain
module Offs = ValueDomain.Offs
@@ -28,8 +27,8 @@ struct
let should_join x y = D.equal x y
let startstate v : D.t = D.empty ()
- let threadenter ctx lval f args : D.t = D.empty ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.empty ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v : D.t = D.empty ()
(* NB! Currently we care only about concrete indexes. Base (seeing only a int domain
@@ -41,7 +40,7 @@ struct
| `Index (_,o) -> `Index (IdxDom.top (), conv_offset o)
| `Field (f,o) -> `Field (f, conv_offset o)
- let access_address ask write lv : BS.extra =
+ let access_address ask write lv =
match ask (Queries.MayPointTo (AddrOf lv)) with
| `LvalSet a when not (Queries.LS.is_top a) ->
let to_extra (v,o) xs = (v, Base.Offs.from_offset (conv_offset o), write) :: xs in
@@ -49,7 +48,7 @@ struct
| _ ->
M.warn "Access to unknown address could be global"; []
- let rec access_one_byval a rw (exp:exp): BS.extra =
+ let rec access_one_byval a rw (exp:exp) =
match exp with
(* Integer literals *)
| Const _ -> []
@@ -69,8 +68,8 @@ struct
| CastE (t, exp) -> access_one_byval a rw exp
| _ -> []
(* Accesses during the evaluation of an lval, not the lval itself! *)
- and access_lv_byval a (lval:lval): BS.extra =
- let rec access_offset (ofs: offset): BS.extra =
+ and access_lv_byval a (lval:lval) =
+ let rec access_offset (ofs: offset) =
match ofs with
| NoOffset -> []
| Field (fld, ofs) -> access_offset ofs
@@ -80,7 +79,7 @@ struct
| Var x, ofs -> access_offset ofs
| Mem n, ofs -> access_one_byval a false n @ access_offset ofs
- let access_byval a (rw: bool) (exps: exp list): BS.extra =
+ let access_byval a (rw: bool) (exps: exp list) =
List.concat (List.map (access_one_byval a rw) exps)
let access_byref ask (exps: exp list) =
@@ -291,4 +290,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/unit.ml b/src/analyses/unit.ml
index 71b29b55b2..4c730cc87f 100644
--- a/src/analyses/unit.ml
+++ b/src/analyses/unit.ml
@@ -3,7 +3,7 @@
open Prelude.Ana
open Analyses
-module Spec : Analyses.Spec =
+module Spec : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
@@ -35,10 +35,10 @@ struct
ctx.local
let startstate v = D.bot ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml
index fec8725916..0d9db2c570 100644
--- a/src/analyses/varEq.ml
+++ b/src/analyses/varEq.ml
@@ -47,8 +47,8 @@ struct
let name () = "var_eq"
let startstate v = D.top ()
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
let const_equal c1 c2 =
@@ -594,4 +594,4 @@ struct
end
let _ =
- MCP.register_analysis (module Spec : Spec)
+ MCP.register_analysis (module Spec : MCPSpec)
diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml
index 226302c9c4..4afe6a1e5e 100644
--- a/src/cdomains/baseDomain.ml
+++ b/src/cdomains/baseDomain.ml
@@ -1,14 +1,18 @@
(** domain of the base analysis *)
open Cil
-
module VD = ValueDomain.Compound
module BI = IntOps.BigIntOps
module CPA =
struct
- include MapDomain.MapBot_LiftTop (Basetype.Variables) (VD)
- let name () = "value domain"
+ module M =
+ struct
+ include MapDomain.LiftTop (VD) (MapDomain.HashCached (MapDomain.MapBot (Basetype.Variables) (VD)))
+ let name () = "value domain"
+ end
+
+ include M
let invariant (c:Invariant.context) (m:t) =
(* VS is used to detect and break cycles in deref_invariant calls *)
@@ -58,42 +62,129 @@ struct
let name () = "array partitioning deps"
end
+
+type 'a basecomponents_t = {
+ cpa: CPA.t;
+ deps: PartDeps.t;
+ priv: 'a;
+} [@@deriving to_yojson]
+
+module BaseComponents (PrivD: Lattice.S):
+sig
+ include Lattice.S with type t = PrivD.t basecomponents_t
+ val op_scheme: (CPA.t -> CPA.t -> CPA.t) -> (PartDeps.t -> PartDeps.t -> PartDeps.t) -> (PrivD.t -> PrivD.t -> PrivD.t) -> t -> t -> t
+end =
+struct
+ type t = PrivD.t basecomponents_t [@@deriving to_yojson]
+
+ include Printable.Std
+ open Pretty
+ let hash r = CPA.hash r.cpa + PartDeps.hash r.deps * 17 + PrivD.hash r.priv * 33
+ let equal r1 r2 =
+ CPA.equal r1.cpa r2.cpa && PartDeps.equal r1.deps r2.deps && PrivD.equal r1.priv r2.priv
+ let compare r1 r2 =
+ let comp1 = CPA.compare r1.cpa r2.cpa in
+ if comp1 <> 0
+ then comp1
+ else let comp2 = PartDeps.compare r1.deps r2.deps in
+ if comp2 <> 0
+ then comp2
+ else PrivD.compare r1.priv r2.priv
+
+
+ let short w r =
+ let first = CPA.short (w-18) r.cpa in
+ let second = PartDeps.short (w-12- String.length first) r.deps in
+ let third = PrivD.short (w-6- String.length first - String.length second) r.priv in
+ "(" ^ first ^ ", " ^ second ^ ", " ^ third ^ ")"
+
+ let pretty_f _ () r =
+ text "(" ++
+ CPA.pretty () r.cpa
+ ++ text ", " ++
+ PartDeps.pretty () r.deps
+ ++ text ", " ++
+ PrivD.pretty () r.priv
+ ++ text ")"
+
+ let isSimple r = CPA.isSimple r.cpa && PartDeps.isSimple r.deps && PrivD.isSimple r.priv
+
+ let printXml f r =
+ BatPrintf.fprintf f "\n\n\n" (Goblintutil.escape (CPA.name ())) CPA.printXml r.cpa (Goblintutil.escape (PartDeps.name ())) PartDeps.printXml r.deps (Goblintutil.escape (PrivD.name ())) PrivD.printXml r.priv
+
+ let pretty () x = pretty_f short () x
+ let name () = CPA.name () ^ " * " ^ PartDeps.name () ^ " * " ^ PrivD.name ()
+
+ let invariant c {cpa; deps; priv} =
+ Invariant.(CPA.invariant c cpa && PartDeps.invariant c deps && PrivD.invariant c priv)
+
+ let of_tuple(cpa, deps, priv):t = {cpa; deps; priv}
+ let to_tuple r = (r.cpa, r.deps, r.priv)
+
+ let arbitrary () =
+ let tr = QCheck.triple (CPA.arbitrary ()) (PartDeps.arbitrary ()) (PrivD.arbitrary ()) in
+ QCheck.map ~rev:to_tuple of_tuple tr
+
+ let bot () = { cpa = CPA.bot (); deps = PartDeps.bot (); priv = PrivD.bot ()}
+ let is_bot {cpa; deps; priv} = CPA.is_bot cpa && PartDeps.is_bot deps && PrivD.is_bot priv
+ let top () = {cpa = CPA.top (); deps = PartDeps.top (); priv = PrivD.bot ()}
+ let is_top {cpa; deps; priv} = CPA.is_top cpa && PartDeps.is_top deps && PrivD.is_top priv
+
+ let leq {cpa=x1; deps=x2; priv=x3 } {cpa=y1; deps=y2; priv=y3} =
+ CPA.leq x1 y1 && PartDeps.leq x2 y2 && PrivD.leq x3 y3
+
+ let pretty_diff () (({cpa=x1; deps=x2; priv=x3}:t),({cpa=y1; deps=y2; priv=y3}:t)): Pretty.doc =
+ if not (CPA.leq x1 y1) then
+ CPA.pretty_diff () (x1,y1)
+ else if not (PartDeps.leq x2 y2) then
+ PartDeps.pretty_diff () (x2,y2)
+ else
+ PrivD.pretty_diff () (x3,y3)
+
+ let op_scheme op1 op2 op3 {cpa=x1; deps=x2; priv=x3} {cpa=y1; deps=y2; priv=y3}: t =
+ {cpa = op1 x1 y1; deps = op2 x2 y2; priv = op3 x3 y3 }
+ let join = op_scheme CPA.join PartDeps.join PrivD.join
+ let meet = op_scheme CPA.meet PartDeps.meet PrivD.meet
+ let widen = op_scheme CPA.widen PartDeps.widen PrivD.widen
+ let narrow = op_scheme CPA.narrow PartDeps.narrow PrivD.narrow
+end
+
module type ExpEvaluator =
sig
- val eval_exp: CPA.t * PartDeps.t -> Cil.exp -> IntOps.BigIntOps.t option
+ type t
+ val eval_exp: t -> Cil.exp -> IntOps.BigIntOps.t option
end
-(* Takes a module specifying how expressions can be evaluated inside the domain and returns the domain *)
-module DomFunctor(ExpEval:ExpEvaluator) =
+(* Takes a module for privatization component and a module specifying how expressions can be evaluated inside the domain and returns the domain *)
+module DomFunctor (PrivD: Lattice.S) (ExpEval: ExpEvaluator with type t = BaseComponents (PrivD).t) =
struct
- include Lattice.Prod(CPA)(PartDeps)
+ include BaseComponents (PrivD)
let (%) = Batteries.(%)
-
let eval_exp x = Option.map BI.to_int64 % (ExpEval.eval_exp x)
- let join ((a1, c1) as one) ((a2, c2) as two) =
+ let join (one:t) (two:t): t =
let cpa_join = CPA.join_with_fct (VD.smart_join (eval_exp one) (eval_exp two)) in
- (cpa_join a1 a2, PartDeps.join c1 c2)
+ op_scheme cpa_join PartDeps.join PrivD.join one two
- let leq ((a1, c1) as one) ((a2, c2) as two) =
+ let leq one two =
let cpa_leq = CPA.leq_with_fct (VD.smart_leq (eval_exp one) (eval_exp two)) in
- cpa_leq a1 a2 && PartDeps.leq c1 c2
+ cpa_leq one.cpa two.cpa && PartDeps.leq one.deps two.deps && PrivD.leq one.priv two.priv
- let widen ((a1, c1) as one) ((a2, c2) as two) =
+ let widen one two: t =
let cpa_widen = CPA.widen_with_fct (VD.smart_widen (eval_exp one) (eval_exp two)) in
- (cpa_widen a1 a2, PartDeps.widen c1 c2)
+ op_scheme cpa_widen PartDeps.widen PrivD.widen one two
end
(* The domain with an ExpEval that only returns constant values for top-level vars that are definite ints *)
-module DomWithTrivialExpEval = DomFunctor(struct
- module M = MapDomain.MapBot_LiftTop (Basetype.Variables) (VD)
+module DomWithTrivialExpEval (PrivD: Lattice.S) = DomFunctor (PrivD) (struct
- let eval_exp (x, _) e =
+ type t = BaseComponents (PrivD).t
+ let eval_exp (r: t) e =
match e with
| Lval (Var v, NoOffset) ->
begin
- match M.find v x with
+ match CPA.find v r.cpa with
| `Int i -> ValueDomain.ID.to_int i
| _ -> None
end
diff --git a/src/cdomains/basetype.ml b/src/cdomains/basetype.ml
index a6e3fdb4ca..35113492e3 100644
--- a/src/cdomains/basetype.ml
+++ b/src/cdomains/basetype.ml
@@ -158,27 +158,27 @@ module Strings: Lattice.S with type t = [`Bot | `Lifted of string | `Top] =
let bot_name = "-"
end)
- module RawBools: Printable.S with type t = bool =
- struct
- include Printable.Std
- open Pretty
- type t = bool [@@deriving to_yojson]
- let hash (x:t) = Hashtbl.hash x
- let equal (x:t) (y:t) = x=y
- let isSimple _ = true
- let short _ (x:t) = if x then "\" true \"" else "\" false \""
- let pretty_f sf () x = text (if x then "true" else "false")
- let pretty () x = text (short () x)
- let name () = "raw bools"
- let pretty_diff () (x,y) = dprintf "%s: %a not leq %a" (name ()) pretty x pretty y
- let printXml f x = BatPrintf.fprintf f "\n\n%s\n\n\n" (short () x)
- end
-
- module Bools: Lattice.S with type t = [`Bot | `Lifted of bool | `Top] =
- Lattice.Flat (RawBools) (struct
- let top_name = "?"
- let bot_name = "-"
- end)
+module RawBools: Printable.S with type t = bool =
+struct
+ include Printable.Std
+ open Pretty
+ type t = bool [@@deriving to_yojson]
+ let hash (x:t) = Hashtbl.hash x
+ let equal (x:t) (y:t) = x=y
+ let isSimple _ = true
+ let short _ (x:t) = if x then "true" else "false"
+ let pretty_f sf () x = text (if x then "true" else "false")
+ let pretty () x = text (short () x)
+ let name () = "raw bools"
+ let pretty_diff () (x,y) = dprintf "%s: %a not leq %a" (name ()) pretty x pretty y
+ let printXml f x = BatPrintf.fprintf f "\n\n%s\n\n\n" (short () x)
+end
+
+module Bools: Lattice.S with type t = [`Bot | `Lifted of bool | `Top] =
+ Lattice.Flat (RawBools) (struct
+ let top_name = "?"
+ let bot_name = "-"
+ end)
module CilExp =
struct
diff --git a/src/cdomains/intDomain.ml b/src/cdomains/intDomain.ml
index a0e51d3ff4..5936e9ae48 100644
--- a/src/cdomains/intDomain.ml
+++ b/src/cdomains/intDomain.ml
@@ -565,6 +565,10 @@ struct
let l2 = if Ints_t.compare l0 l1 = 0 then l0 else min l1 (min_int ik) in
let u2 = if Ints_t.compare u0 u1 = 0 then u0 else max u1 (max_int ik) in
norm ik @@ Some (l2,u2)
+ let widen ik x y =
+ let r = widen ik x y in
+ if M.tracing then M.trace "int" "interval widen %a %a -> %a\n" pretty x pretty y pretty r;
+ r
let narrow ik x y =
match x, y with
diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml
index 1a90a5df66..83303790eb 100644
--- a/src/cdomains/lockDomain.ml
+++ b/src/cdomains/lockDomain.ml
@@ -46,6 +46,7 @@ struct
let pretty = pretty_f short
end
+ (* TODO: use SetDomain.Reverse *)
module ReverseAddrSet = SetDomain.ToppedSet (Lock)
(struct let topname = "All mutexes" end)
@@ -104,6 +105,7 @@ end
module Symbolic =
struct
+ (* TODO: use SetDomain.Reverse *)
module S = SetDomain.ToppedSet (Exp) (struct let topname = "All mutexes" end)
include Lattice.Reverse (S)
diff --git a/src/cdomains/lvalMapDomain.ml b/src/cdomains/lvalMapDomain.ml
index 388826edb7..aeb051fc95 100644
--- a/src/cdomains/lvalMapDomain.ml
+++ b/src/cdomains/lvalMapDomain.ml
@@ -77,6 +77,7 @@ struct
end
type r = R.t
open R
+ (* TODO: use SetDomain.Reverse? *)
module Must' = SetDomain.ToppedSet (R) (struct let topname = "top" end)
module Must = Lattice.Reverse (Must')
module May = SetDomain.ToppedSet (R) (struct let topname = "top" end)
@@ -154,10 +155,6 @@ struct
module V = V
module MD = MapDomain.MapBot (Lval.CilLval) (V)
include MD
- (* Used to access additional functions of Map.
- Can't use BatMap because type is not compatible with MD.
- Also avoids dependencies for other files using the following functions. *)
- module MDMap = Legacy.Map.Make (Lval.CilLval) (* why does Make (K) not work? *)
(* Map functions *)
(* find that resolves aliases *)
@@ -168,7 +165,7 @@ struct
let get_aliased k m = (* sources: get list of keys that link to k *)
(* iter (fun k' (x,y) -> if V.is_alias (x,y) then print_endline ("alias "^V.string_of_key k'^" -> "^V.string_of_key (Set.choose y).key)) m; *)
(* TODO V.get_alias v=k somehow leads to Out_of_memory... *)
- filter (fun k' v -> V.is_alias v && V.string_of_key (V.get_alias v)=V.string_of_key k) m |> MDMap.bindings |> List.map fst
+ filter (fun k' v -> V.is_alias v && V.string_of_key (V.get_alias v)=V.string_of_key k) m |> bindings |> List.map fst
let get_aliases k m = (* get list of all other keys that have the same pointee *)
match get_alias k m with
| Some k' -> [k] (* k links to k' *)
@@ -213,7 +210,7 @@ struct
(* only keep globals, aliases to them and special variables *)
let only_globals m = filter (fun k v -> (fst k).vglob || V.is_alias v && (fst (V.get_alias v)).vglob || is_special_var k) m
(* adds all the bindings from m2 to m1 (overwrites!) *)
- let add_all m1 m2 = add_list (MDMap.bindings m2) m1
+ let add_all m1 m2 = add_list (bindings m2) m1
(* callstack for locations *)
let callstack_var = Goblintutil.create_var @@ Cil.makeVarinfo false "@callstack" Cil.voidType, `NoOffset
@@ -231,7 +228,7 @@ struct
let flatten_sets = List.fold_left Set.union Set.empty in
without_special_vars m
|> filter (fun k v -> V.may p v && not (V.is_alias v))
- |> MDMap.bindings |> List.map (fun (k,v) -> V.filter' p v)
+ |> bindings |> List.map (fun (k,v) -> V.filter' p v)
|> List.split |> (fun (x,y) -> flatten_sets x, flatten_sets y)
let filter_records k p m = (* filters both sets of k *)
if mem k m then V.filter' p (find' k m) else Set.empty, Set.empty
@@ -244,7 +241,7 @@ struct
let string_of_key k = V.string_of_key k
let string_of_keys rs = Set.map (V.string_of_key % V.key) rs |> Set.elements |> String.concat ", "
let string_of_entry k m = string_of_key k ^ ": " ^ string_of_state k m
- let string_of_map m = List.map (fun (k,v) -> string_of_entry k m) (MDMap.bindings m)
+ let string_of_map m = List.map (fun (k,v) -> string_of_entry k m) (bindings m)
let warn ?may:(may=false) ?loc:(loc=[!Tracing.current_loc]) msg =
Messages.report ~loc:(List.last loc) (if may then "{yellow}MAYBE "^msg else "{YELLOW}"^msg)
diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml
new file mode 100644
index 0000000000..02535f30bc
--- /dev/null
+++ b/src/cdomains/preValueDomain.ml
@@ -0,0 +1,4 @@
+module ID = IntDomain.IntDomTuple
+module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind)
+module AD = AddressDomain.AddressSet (IndexDomain)
+module Addr = Lval.NormalLat (IndexDomain)
\ No newline at end of file
diff --git a/src/cdomains/shapeDomain.ml b/src/cdomains/shapeDomain.ml
index dfdaf7e802..e0c75564ea 100644
--- a/src/cdomains/shapeDomain.ml
+++ b/src/cdomains/shapeDomain.ml
@@ -40,6 +40,7 @@ struct
let isSimple _ = true
end
+(* TODO: use SetDomain.Reverse? *)
module ListPtrSet = SetDomain.ToppedSet (ListPtr) (struct let topname = "All elements" end)
module ListPtrSetR = Lattice.Reverse (ListPtrSet)
@@ -74,7 +75,7 @@ let is_private ask (lp:ListPtr.t) =
match ask Queries.MustBeSingleThreaded with
| `Bot | `MustBool true -> true
| _ ->
- match ask (Queries.MayBePublic v) with
+ match ask (Queries.MayBePublic {global=v; write=false}) with
| `Bot | `MayBool false -> true
| _ -> false
in
@@ -525,7 +526,7 @@ let sync_one ask gl upd (sm:SHMap.t) : SHMap.t * ((varinfo * bool) list) * ((var
blab (proper_list_segment ask gl lp sm) (fun () -> Pretty.printf "no donut\n") &&
let pointedBy = reflTransBack ask gl sm (lp) (ListPtrSet.empty ()) in
let alive =
- match MyLiveness.getLiveSet !Cilfacade.currentStatement.sid with
+ match MyLiveness.getLiveSet !Cilfacade.current_statement.sid with
| Some x -> x
| _ -> Usedef.VS.empty
in
diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml
index e5f1da0ff4..fcdd060ddb 100644
--- a/src/cdomains/valueDomain.ml
+++ b/src/cdomains/valueDomain.ml
@@ -2,10 +2,7 @@ open Cil
open Pretty
open GobConfig
-module ID = IntDomain.IntDomTuple
-module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind)
-module AD = AddressDomain.AddressSet (IndexDomain)
-module Addr = Lval.NormalLat (IndexDomain)
+include PreValueDomain
module Offs = Lval.Offset (IndexDomain)
module M = Messages
module GU = Goblintutil
diff --git a/src/domains/events.ml b/src/domains/events.ml
new file mode 100644
index 0000000000..183c32f8a1
--- /dev/null
+++ b/src/domains/events.ml
@@ -0,0 +1,17 @@
+open Prelude.Ana
+
+type t =
+ | Lock of LockDomain.Addr.t
+ | Unlock of LockDomain.Addr.t
+ | Escape of EscapeDomain.EscapedVars.t
+ | EnterMultiThreaded
+ | SplitBranch of exp * bool (** Used to simulate old branch-based split. *)
+ | AssignSpawnedThread of lval * varinfo (** Assign spawned thread's ID to lval. *)
+
+let pretty () = function
+ | Lock m -> dprintf "Lock %a" LockDomain.Addr.pretty m
+ | Unlock m -> dprintf "Unock %a" LockDomain.Addr.pretty m
+ | Escape escaped -> dprintf "Escape %a" EscapeDomain.EscapedVars.pretty escaped
+ | EnterMultiThreaded -> text "EnterMultiThreaded"
+ | SplitBranch (exp, tv) -> dprintf "SplitBranch (%a, %B)" d_exp exp tv
+ | AssignSpawnedThread (lval, tid) -> dprintf "AssignSpawnedThread (%a, %a)" d_lval lval d_varinfo tid
diff --git a/src/domains/invariantCil.ml b/src/domains/invariantCil.ml
index 2ab65a2fba..4d15f2cb72 100644
--- a/src/domains/invariantCil.ml
+++ b/src/domains/invariantCil.ml
@@ -31,7 +31,7 @@ let exp_replace_original_name e =
let var_fundecs: fundec option VM.t Lazy.t =
lazy (
- foldGlobals !Cilfacade.ugglyImperativeHack (fun acc global ->
+ foldGlobals !Cilfacade.current_file (fun acc global ->
match global with
| GFun (fd, _) ->
let acc = VM.add fd.svar None acc in (* function itself can be used as a variable (function pointer) *)
diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml
index 0c59639f30..742596f3b1 100644
--- a/src/domains/lattice.ml
+++ b/src/domains/lattice.ml
@@ -127,6 +127,21 @@ struct
let bot () = lift (Base.bot ())
end
+module HashCached (M: S) =
+struct
+ include Printable.HashCached (M)
+
+ let leq = lift_f2 M.leq
+ let join = lift_f2' M.join
+ let meet = lift_f2' M.meet
+ let widen = lift_f2' M.widen
+ let narrow = lift_f2' M.narrow
+ let bot () = lift @@ M.bot ()
+ let is_bot = lift_f M.is_bot
+ let top () = lift @@ M.top ()
+ let is_top = lift_f M.is_top
+end
+
module Flat (Base: Printable.S) (N: Printable.LiftingNames) =
struct
include Printable.Lift (Base) (N)
diff --git a/src/domains/mapDomain.ml b/src/domains/mapDomain.ml
index 21d122ef95..a3e759f352 100644
--- a/src/domains/mapDomain.ml
+++ b/src/domains/mapDomain.ml
@@ -4,9 +4,9 @@ open Pretty
module ME = Messages
module GU = Goblintutil
-module type S =
+module type PS =
sig
- include Lattice.S
+ include Printable.S
type key
(** The type of the map keys. *)
@@ -21,6 +21,7 @@ sig
val iter: (key -> value -> unit) -> t -> unit
val map: (value -> value) -> t -> t
val filter: (key -> value -> bool) -> t -> t
+ val mapi: (key -> value -> value) -> t -> t
val fold: (key -> value -> 'a -> 'a) -> t -> 'a -> 'a
val add_list: (key * value) list -> t -> t
@@ -32,6 +33,20 @@ sig
val long_map2: (value -> value -> value) -> t -> t -> t
val merge : (key -> value option -> value option -> value option) -> t -> t -> t
+ val cardinal: t -> int
+ val choose: t -> key * value
+ val singleton: key -> value -> t
+ val empty: unit -> t
+ val is_empty: t -> bool
+ val exists: (key -> value -> bool) -> t -> bool
+ val bindings: t -> (key * value) list
+end
+
+module type S =
+sig
+ include PS
+ include Lattice.S with type t := t
+
val widen_with_fct: (value -> value -> value) -> t -> t -> t
(* Widen using a custom widening function for value rather than the default one for value *)
val join_with_fct: (value -> value -> value) -> t -> t -> t
@@ -56,7 +71,9 @@ end
(* Just a global hack for tracing individual variables. *)
-module PMap (Domain: Groupable) (Range: Lattice.S) =
+module PMap (Domain: Groupable) (Range: Lattice.S) : PS with
+ type key = Domain.t and
+ type value = Range.t =
struct
module M = Deriving.Map.Make (Domain)
@@ -64,6 +81,7 @@ struct
type key = Domain.t
type value = Range.t
type t = Range.t M.t [@@deriving to_yojson] (* key -> value mapping *)
+
let trace_enabled = Domain.trace_enabled
(* And some braindead definitions, because I would want to do
@@ -80,13 +98,21 @@ struct
let filter = M.filter
(* And one less brainy definition *)
let for_all2 = M.equal
- let equal = for_all2 Range.equal
+ let equal x y = x == y || for_all2 Range.equal x y
let compare x y = if equal x y then 0 else M.compare Range.compare x y
let merge = M.merge
let for_all = M.for_all
let find_first = M.find_first
let hash xs = fold (fun k v a -> a + (Domain.hash k * Range.hash v)) xs 0
+ let cardinal = M.cardinal
+ let choose = M.choose
+ let singleton = M.singleton
+ let empty () = M.empty
+ let is_empty = M.is_empty
+ let exists = M.exists
+ let bindings = M.bindings
+
let add_list keyvalues m =
List.fold_left (fun acc (key,value) -> add key value acc) m keyvalues
@@ -161,11 +187,181 @@ struct
let arbitrary () = QCheck.always M.empty (* S TODO: non-empty map *)
end
+(* TODO: why is HashCached.hash significantly slower as a functor compared to being inlined into PMap? *)
+module HashCached (M: S) : S with
+ type key = M.key and
+ type value = M.value =
+struct
+ include Lattice.HashCached (M)
+
+ type key = M.key
+ type value = M.value
+
+ let add k v = lift_f' (M.add k v)
+ let remove k = lift_f' (M.remove k)
+ let find k = lift_f (M.find k)
+ let find_opt k = lift_f (M.find_opt k)
+ let mem k = lift_f (M.mem k)
+ let iter f = lift_f (M.iter f)
+ let map f = lift_f' (M.map f)
+ let mapi f = lift_f' (M.mapi f)
+ let fold f x a = M.fold f (unlift x) a
+ let filter f = lift_f' (M.filter f)
+ let merge f = lift_f2' (M.merge f)
+ let for_all f = lift_f (M.for_all f)
+
+ let cardinal = lift_f M.cardinal
+ let choose = lift_f M.choose
+ let singleton k v = lift @@ M.singleton k v
+ let empty () = lift @@ M.empty ()
+ let is_empty = lift_f M.is_empty
+ let exists p = lift_f (M.exists p)
+ let bindings = lift_f M.bindings
+
+
+ let add_list keyvalues = lift_f' (M.add_list keyvalues)
+
+ let add_list_set keys value = lift_f' (M.add_list_set keys value)
+
+ let add_list_fun keys f = lift_f' (M.add_list_fun keys f)
+
+ let long_map2 op = lift_f2' (M.long_map2 op)
+
+ let map2 op = lift_f2' (M.map2 op)
+
+ let leq_with_fct f = lift_f2 (M.leq_with_fct f)
+ let join_with_fct f = lift_f2' (M.join_with_fct f)
+ let widen_with_fct f = lift_f2' (M.widen_with_fct f)
+end
+
+(* TODO: this is very slow because every add/remove in a fold-loop relifts *)
+module HConsed (M: S) : S with
+ type key = M.key and
+ type value = M.value =
+struct
+ include Lattice.HConsed (M)
+
+ type key = M.key
+ type value = M.value
+
+ let lift_f' f x = lift @@ lift_f f x
+ let lift_f2' f x y = lift @@ lift_f2 f x y
+
+ let add k v = lift_f' (M.add k v)
+ let remove k = lift_f' (M.remove k)
+ let find k = lift_f (M.find k)
+ let find_opt k = lift_f (M.find_opt k)
+ let mem k = lift_f (M.mem k)
+ let iter f = lift_f (M.iter f)
+ let map f = lift_f' (M.map f)
+ let mapi f = lift_f' (M.mapi f)
+ let fold f x a = M.fold f (unlift x) a
+ let filter f = lift_f' (M.filter f)
+ let merge f = lift_f2' (M.merge f)
+ let for_all f = lift_f (M.for_all f)
+
+ let cardinal = lift_f M.cardinal
+ let choose = lift_f M.choose
+ let singleton k v = lift @@ M.singleton k v
+ let empty () = lift @@ M.empty ()
+ let is_empty = lift_f M.is_empty
+ let exists p = lift_f (M.exists p)
+ let bindings = lift_f M.bindings
+
+
+ let add_list keyvalues = lift_f' (M.add_list keyvalues)
-module MapBot (Domain: Groupable) (Range: Lattice.S) (*: S with
+ let add_list_set keys value = lift_f' (M.add_list_set keys value)
+
+ let add_list_fun keys f = lift_f' (M.add_list_fun keys f)
+
+ let long_map2 op = lift_f2' (M.long_map2 op)
+
+ let map2 op = lift_f2' (M.map2 op)
+
+ let leq_with_fct f = lift_f2 (M.leq_with_fct f)
+ let join_with_fct f = lift_f2' (M.join_with_fct f)
+ let widen_with_fct f = lift_f2' (M.widen_with_fct f)
+end
+
+module Timed (M: S) : S with
+ type key = M.key and
+ type value = M.value =
+struct
+ let time str f arg = Stats.time (M.name ()) (Stats.time str f) arg
+
+ (* Printable.S *)
+ type t = M.t
+
+ let equal x y = time "equal" (M.equal x) y
+ let compare x y = time "compare" (M.compare x) y
+ let hash x = time "hash" M.hash x
+ let tag x = time "tag" M.tag x
+ (* TODO: time these also? *)
+ let name = M.name
+ let to_yojson = M.to_yojson
+ let isSimple = M.isSimple
+ let short = M.short
+ let pretty_f = M.pretty_f
+ let pretty = M.pretty
+ let pretty_diff = M.pretty_diff
+ let printXml = M.printXml
+ let arbitrary = M.arbitrary
+ let invariant = M.invariant
+
+ (* Lattice.S *)
+ let top () = time "top" M.top ()
+ let is_top x = time "is_top" M.is_top x
+ let bot () = time "bot" M.bot ()
+ let is_bot x = time "is_bot" M.is_bot x
+ let leq x y = time "leq" (M.leq x) y
+ let join x y = time "join" (M.join x) y
+ let meet x y = time "meet" (M.meet x) y
+ let widen x y = time "widen" (M.widen x) y
+ let narrow x y = time "narrow" (M.narrow x) y
+
+ (* MapDomain.S *)
+ type key = M.key
+ type value = M.value
+
+ let add k v x = time "add" (M.add k v) x
+ let remove k x = time "remove" (M.remove k) x
+ let find k x = time "find" (M.find k) x
+ let find_opt k x = time "find_opt" (M.find_opt k) x
+ let mem k x = time "mem" (M.mem k) x
+ let iter f x = time "iter" (M.iter f) x
+ let map f x = time "map" (M.map f) x
+ let mapi f x = time "mapi" (M.mapi f) x
+ let fold f x a = time "fold" (M.fold f x) a
+ let filter f x = time "filter" (M.filter f) x
+ let merge f x y = time "merge" (M.merge f x) y
+ let for_all f x = time "for_all" (M.for_all f) x
+
+ let cardinal x = time "cardinal" M.cardinal x
+ let choose x = time "choose" M.choose x
+ let singleton k v = time "singleton" (M.singleton k) v
+ let empty () = time "empty" M.empty ()
+ let is_empty x = time "is_empty" M.is_empty x
+ let exists p x = time "exists" (M.exists p) x
+ let bindings x = time "bindings" M.bindings x
+
+
+ let add_list xs x = time "add_list" (M.add_list xs) x
+ let add_list_set ks v x = time "add_list_set" (M.add_list_set ks v) x
+ let add_list_fun ks f x = time "add_list_fun" (M.add_list_fun ks f) x
+
+ let long_map2 f x y = time "long_map2" (M.long_map2 f x) y
+
+ let map2 f x y = time "map2" (M.map2 f x) y
+
+ let leq_with_fct f x y = time "leq_with_fct" (M.leq_with_fct f x) y
+ let join_with_fct f x y = time "join_with_fct" (M.join_with_fct f x) y
+ let widen_with_fct f x y = time "widen_with_fct" (M.widen_with_fct f x) y
+end
+
+module MapBot (Domain: Groupable) (Range: Lattice.S) : S with
type key = Domain.t and
-type value = Range.t and
-type t = Range.t Map.Make(Domain).t *) =
+ type value = Range.t =
struct
include PMap (Domain) (Range)
@@ -180,9 +376,9 @@ struct
let find x m = try find x m with | Not_found -> Range.bot ()
let top () = Lattice.unsupported "partial map top"
- let bot () = M.empty
+ let bot () = empty ()
let is_top _ = false
- let is_bot = M.is_empty
+ let is_bot = is_empty
let pretty_diff () ((m1:t),(m2:t)): Pretty.doc =
let p key value =
@@ -214,10 +410,9 @@ struct
let narrow = map2 Range.narrow
end
-module MapTop (Domain: Groupable) (Range: Lattice.S): S with
+module MapTop (Domain: Groupable) (Range: Lattice.S) : S with
type key = Domain.t and
-type value = Range.t and
-type t = Range.t Map.Make(Domain).t =
+ type value = Range.t =
struct
include PMap (Domain) (Range)
@@ -231,9 +426,9 @@ struct
let leq = leq_with_fct Range.leq
let find x m = try find x m with | Not_found -> Range.top ()
- let top () = M.empty
+ let top () = empty ()
let bot () = Lattice.unsupported "partial map bot"
- let is_top = M.is_empty
+ let is_top = is_empty
let is_bot _ = false
(* let cleanup m = fold (fun k v m -> if Range.is_top v then remove k m else m) m m *)
@@ -251,29 +446,28 @@ struct
let pretty_diff () ((m1:t),(m2:t)): Pretty.doc =
let p key value =
- not (try Range.leq value (find key m2) with Not_found -> true)
+ not (try Range.leq (find key m1) value with Not_found -> false)
in
let report key v1 v2 =
Pretty.dprintf "Map: %a =@?@[%a@]"
Domain.pretty key Range.pretty_diff (v1,v2)
in
let diff_key k v = function
- | None when p k v -> Some (report k v (find k m2))
- | Some w when p k v -> Some (w++Pretty.line++report k v (find k m2))
+ | None when p k v -> Some (report k (find k m1) v)
+ | Some w when p k v -> Some (w++Pretty.line++report k (find k m1) v)
| x -> x
in
- match fold diff_key m1 None with
+ match fold diff_key m2 None with
| Some w -> w
| None -> Pretty.dprintf "No binding grew."
end
exception Fn_over_All of string
-module MapBot_LiftTop (Domain: Groupable) (Range: Lattice.S) (* : S with
- type key = Domain.t and
-type value = Range.t *) =
+module LiftTop (Range: Lattice.S) (M: S with type value = Range.t): S with
+ type key = M.key and
+ type value = Range.t =
struct
- module M = MapBot (Domain) (Range)
include Lattice.LiftTop (M)
type key = M.key
@@ -365,13 +559,43 @@ struct
| (`Lifted x, `Lifted y) -> `Lifted (M.widen_with_fct f x y)
| _ -> y
+ let cardinal = function
+ | `Top -> raise (Fn_over_All "cardinal")
+ | `Lifted x -> M.cardinal x
+
+ let choose = function
+ | `Top -> raise (Fn_over_All "choose")
+ | `Lifted x -> M.choose x
+
+ let singleton k v = `Lifted (M.singleton k v)
+ let empty () = `Lifted (M.empty ())
+ let is_empty = function
+ | `Top -> false
+ | `Lifted x -> M.is_empty x
+ let exists f = function
+ | `Top -> raise (Fn_over_All "exists")
+ | `Lifted x -> M.exists f x
+ let bindings = function
+ | `Top -> raise (Fn_over_All "bindings")
+ | `Lifted x -> M.bindings x
+ let mapi f = function
+ | `Top -> `Top
+ | `Lifted x -> `Lifted (M.mapi f x)
end
-module MapTop_LiftBot (Domain: Groupable) (Range: Lattice.S): S with
+module MapBot_LiftTop (Domain: Groupable) (Range: Lattice.S) : S with
type key = Domain.t and
-type value = Range.t =
+ type value = Range.t =
+struct
+ module M = MapBot (Domain) (Range)
+ include LiftTop (Range) (M)
+end
+
+
+module LiftBot (Range: Lattice.S) (M: S with type value = Range.t): S with
+ type key = M.key and
+ type value = Range.t =
struct
- module M = MapTop (Domain) (Range)
include Lattice.LiftBot (M)
type key = M.key
@@ -462,4 +686,35 @@ struct
| (`Bot, _) -> true
| (_, `Bot) -> false
| (`Lifted x, `Lifted y) -> M.leq_with_fct f x y
+
+ let cardinal = function
+ | `Bot -> raise (Fn_over_All "cardinal")
+ | `Lifted x -> M.cardinal x
+
+ let choose = function
+ | `Bot -> raise (Fn_over_All "choose")
+ | `Lifted x -> M.choose x
+
+ let singleton k v = `Lifted (M.singleton k v)
+ let empty () = `Lifted (M.empty ())
+ let is_empty = function
+ | `Bot -> false
+ | `Lifted x -> M.is_empty x
+ let exists f = function
+ | `Bot -> raise (Fn_over_All "exists")
+ | `Lifted x -> M.exists f x
+ let bindings = function
+ | `Bot -> raise (Fn_over_All "bindings")
+ | `Lifted x -> M.bindings x
+ let mapi f = function
+ | `Bot -> `Bot
+ | `Lifted x -> `Lifted (M.mapi f x)
end
+
+module MapTop_LiftBot (Domain: Groupable) (Range: Lattice.S): S with
+ type key = Domain.t and
+ type value = Range.t =
+struct
+ module M = MapTop (Domain) (Range)
+ include LiftBot (Range) (M)
+end
\ No newline at end of file
diff --git a/src/domains/printable.ml b/src/domains/printable.ml
index dc5e6ee0f2..e801e82eb0 100644
--- a/src/domains/printable.ml
+++ b/src/domains/printable.ml
@@ -162,6 +162,45 @@ struct
let arbitrary () = QCheck.map ~rev:unlift lift (Base.arbitrary ())
end
+module HashCached (M: S) =
+struct
+ let name () = "HashCached " ^ M.name ()
+
+ type t =
+ {
+ m: M.t;
+ lazy_hash: int Lazy.t;
+ }
+
+ let lift m = {m; lazy_hash = lazy (M.hash m)}
+ let unlift {m; _} = m
+
+ let lift_f f x = f (unlift x)
+ let lift_f' f x = lift @@ lift_f f x
+ let lift_f2 f x y = f (unlift x) (unlift y)
+ let lift_f2' f x y = lift @@ lift_f2 f x y
+
+ let equal = lift_f2 M.equal
+ let compare = lift_f2 M.compare
+ let hash x = Lazy.force x.lazy_hash
+ let short w = lift_f (M.short w)
+ let isSimple = lift_f M.isSimple
+
+ let pretty_f short () = lift_f (M.pretty_f (fun w x -> short w (lift x)) ())
+
+ let pretty () x = pretty_f short () x
+
+ let pretty_diff () ((x:t),(y:t)): Pretty.doc = M.pretty_diff () (unlift x, unlift y)
+ let printXml f = lift_f (M.printXml f)
+
+ let to_yojson = lift_f (M.to_yojson)
+
+ let arbitrary () = QCheck.map ~rev:unlift lift (M.arbitrary ())
+
+ let tag = lift_f M.tag
+ let invariant c = lift_f (M.invariant c)
+end
+
module Lift (Base: S) (N: LiftingNames) =
struct
type t = [`Bot | `Lifted of Base.t | `Top] [@@deriving to_yojson]
diff --git a/src/domains/queries.ml b/src/domains/queries.ml
index f69f87eed9..e9bad88a5d 100644
--- a/src/domains/queries.ml
+++ b/src/domains/queries.ml
@@ -40,7 +40,11 @@ type t = EqualSet of exp
| Regions of exp
| MayEscape of varinfo
| Priority of string
- | MayBePublic of varinfo
+ | MayBePublic of {global: varinfo; write: bool} (* old behavior with write=false *)
+ | MayBePublicWithout of {global: varinfo; write: bool; without_mutex: PreValueDomain.Addr.t}
+ | MustBeProtectedBy of {mutex: PreValueDomain.Addr.t; global: varinfo; write: bool}
+ | CurrentLockset
+ | MustBeAtomic
| MustBeSingleThreaded
| MustBeUniqueThread
| CurrentThreadId
diff --git a/src/domains/setDomain.ml b/src/domains/setDomain.ml
index 716b4b2f2b..47e9bac5ec 100644
--- a/src/domains/setDomain.ml
+++ b/src/domains/setDomain.ml
@@ -611,3 +611,9 @@ struct
1, QCheck.always All
] (* S TODO: decide frequencies *)
end
+
+module Reverse (Base: S) =
+struct
+ include Base
+ include Lattice.Reverse (Base)
+end
\ No newline at end of file
diff --git a/src/dune b/src/dune
index feb7d05b92..71b10bb2c3 100644
--- a/src/dune
+++ b/src/dune
@@ -8,7 +8,7 @@
(public_name goblint.lib)
(wrapped false)
(modules :standard \ goblint mainarinc maindomaintest mainspec
- apronDomain poly violationZ3)
+ apronDomain poly violationZ3 privPrecCompare)
(libraries goblint-cil.all-features batteries.unthreaded zarith_stubs_js
qcheck-core.runner)
(preprocess
@@ -26,6 +26,14 @@
(flags :standard -linkall)
)
+(executable
+ (name privPrecCompare)
+ (modules privPrecCompare)
+ (libraries goblint.lib)
+ (preprocess (staged_pps ppx_import ppx_deriving.std ppx_deriving_yojson ppx_distr_guards ocaml-monadic))
+ (flags :standard -linkall)
+)
+
(rule
(targets goblint.ml config.ml version.ml)
(mode fallback) ; do nothing if all targets already exist
diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml
index fab81cdc13..3f19fb4aec 100644
--- a/src/framework/analyses.ml
+++ b/src/framework/analyses.ml
@@ -378,6 +378,7 @@ end
*)
type ('d,'g,'c) ctx =
{ ask : Queries.t -> Queries.Result.t
+ ; emit : Events.t -> unit
; node : MyCFG.node
; prev_node: MyCFG.node
; control_context : Obj.t (** (Control.get_spec ()) context, represented type: unit -> (Control.get_spec ()).C.t *)
@@ -388,7 +389,7 @@ type ('d,'g,'c) ctx =
; presub : (string * Obj.t) list
; postsub : (string * Obj.t) list
; spawn : lval option -> varinfo -> exp list -> unit
- ; split : 'd -> exp -> bool -> unit
+ ; split : 'd -> Events.t list -> unit
; sideg : varinfo -> 'g -> unit
; assign : ?name:string -> lval -> exp -> unit
}
@@ -427,7 +428,7 @@ sig
val context : D.t -> C.t
val call_descr : fundec -> C.t -> string
- val sync : (D.t, G.t, C.t) ctx -> D.t * (varinfo * G.t) list
+ val sync : (D.t, G.t, C.t) ctx -> [`Normal | `Join | `Return] -> D.t * (varinfo * G.t) list
val query : (D.t, G.t, C.t) ctx -> Queries.t -> Queries.Result.t
val assign: (D.t, G.t, C.t) ctx -> lval -> exp -> D.t
val vdecl : (D.t, G.t, C.t) ctx -> varinfo -> D.t
@@ -443,10 +444,19 @@ sig
val enter : (D.t, G.t, C.t) ctx -> lval option -> varinfo -> exp list -> (D.t * D.t) list
val combine : (D.t, G.t, C.t) ctx -> lval option -> exp -> varinfo -> exp list -> C.t -> D.t -> D.t
- val threadenter : (D.t, G.t, C.t) ctx -> lval option -> varinfo -> exp list -> D.t
+ (** Returns initial state for created thread. *)
+ val threadenter : (D.t, G.t, C.t) ctx -> lval option -> varinfo -> exp list -> D.t list
+
+ (** Updates the local state of the creator thread using initial state of created thread. *)
val threadspawn : (D.t, G.t, C.t) ctx -> lval option -> varinfo -> exp list -> (D.t, G.t, C.t) ctx -> D.t
end
+module type MCPSpec =
+sig
+ include Spec
+ val event : (D.t, G.t, C.t) ctx -> Events.t -> (D.t, G.t, C.t) ctx -> D.t
+end
+
module type SpecHC = (* same as Spec but with relift function for hashcons in context module *)
sig
module C : Printable.HC
@@ -580,10 +590,12 @@ struct
let query _ (q:Queries.t) = Queries.Result.top ()
(* Don't know anything --- most will want to redefine this. *)
+ let event ctx _ _ = ctx.local
+
let morphstate v d = d
(* Only for those who track thread IDs. *)
- let sync ctx = (ctx.local,[])
+ let sync ctx _ = (ctx.local,[])
(* Most domains do not have a global part. *)
let context x = x
diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml
index 1784e52c4c..5ea9ab2d7c 100644
--- a/src/framework/constraints.ml
+++ b/src/framework/constraints.ml
@@ -37,11 +37,11 @@ struct
let conv ctx =
{ ctx with local = D.unlift ctx.local
- ; split = (fun d e tv -> ctx.split (D.lift d) e tv )
+ ; split = (fun d es -> ctx.split (D.lift d) es )
}
- let sync ctx =
- let d, diff = S.sync (conv ctx) in
+ let sync ctx reason =
+ let d, diff = S.sync (conv ctx) reason in
D.lift d, diff
let query ctx q =
@@ -81,7 +81,7 @@ struct
D.lift @@ S.combine (conv ctx) r fe f args fc (D.unlift es)
let threadenter ctx lval f args =
- D.lift @@ S.threadenter (conv ctx) lval f args
+ List.map D.lift @@ S.threadenter (conv ctx) lval f args
let threadspawn ctx lval f args fctx =
D.lift @@ S.threadspawn (conv ctx) lval f args (conv fctx)
@@ -116,8 +116,8 @@ struct
let conv ctx =
{ ctx with context = (fun () -> C.unlift (ctx.context ())) }
- let sync ctx =
- let d, diff = S.sync (conv ctx) in
+ let sync ctx reason =
+ let d, diff = S.sync (conv ctx) reason in
d, diff
let query ctx q =
@@ -215,15 +215,15 @@ struct
let conv ctx =
{ ctx with local = fst ctx.local
- ; split = (fun d e tv -> ctx.split (d, snd ctx.local) e tv )
+ ; split = (fun d es -> ctx.split (d, snd ctx.local) es )
}
let lift_fun ctx f g h =
f @@ h (g (conv ctx))
- let sync ctx =
+ let sync ctx reason =
let liftpair (x, y) = (x, snd ctx.local), y in
- lift_fun ctx liftpair S.sync identity
+ lift_fun ctx liftpair S.sync ((|>) reason)
let enter' ctx r f args =
let liftmap = List.map (fun (x,y) -> (x, snd ctx.local), (y, snd ctx.local)) in
@@ -244,7 +244,7 @@ struct
let special ctx r f args = lift_fun ctx (lift ctx) S.special ((|>) args % (|>) f % (|>) r)
let combine' ctx r fe f args fc es = lift_fun ctx (lift ctx) S.combine (fun p -> p r fe f args fc (fst es))
- let threadenter ctx lval f args = lift_fun ctx lift_start_level S.threadenter ((|>) args % (|>) f % (|>) lval)
+ let threadenter ctx lval f args = lift_fun ctx (List.map lift_start_level) S.threadenter ((|>) args % (|>) f % (|>) lval)
let threadspawn ctx lval f args fctx = lift_fun ctx (lift ctx) S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval)
let leq0 = function
@@ -355,11 +355,11 @@ struct
let conv ctx =
{ ctx with context = (fun () -> fst (ctx.context ()))
; local = fst ctx.local
- ; split = (fun d e tv -> ctx.split (d, snd ctx.local) e tv )
+ ; split = (fun d es -> ctx.split (d, snd ctx.local) es )
}
let lift_fun ctx f g = g (f (conv ctx)), snd ctx.local
- let sync ctx = let d, ds = S.sync (conv ctx) in (d, snd ctx.local), ds
+ let sync ctx reason = let d, ds = S.sync (conv ctx) reason in (d, snd ctx.local), ds
let query ctx = S.query (conv ctx)
let assign ctx lv e = lift_fun ctx S.assign ((|>) e % (|>) lv)
let vdecl ctx v = lift_fun ctx S.vdecl ((|>) v)
@@ -371,7 +371,7 @@ struct
let skip ctx = lift_fun ctx S.skip identity
let special ctx r f args = lift_fun ctx S.special ((|>) args % (|>) f % (|>) r)
- let threadenter ctx lval f args = lift_fun ctx S.threadenter ((|>) args % (|>) f % (|>) lval)
+ let threadenter ctx lval f args = S.threadenter (conv ctx) lval f args |> List.map (fun d -> (d, snd ctx.local))
let threadspawn ctx lval f args fctx = lift_fun ctx S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval)
let enter ctx r f args =
@@ -395,7 +395,8 @@ module WidenContextLifterSide (S:Spec)
=
struct
module B = WidenContextLifter (S) (* can't just include this since type of ctx and some tf functions are different; TODO some generic functor to lift functions with conv, inj, proj? *)
- include (B : module type of B with module C := B.C)
+ (* include (B : module type of B with module C := B.C) *)
+ include B
(* same as WidenContextLifter, but with a different C *)
module C = S.C
@@ -406,11 +407,11 @@ struct
(* copied from WidenContextLifter... *)
let conv ctx =
{ ctx with local = fst ctx.local
- ; split = (fun d e tv -> ctx.split (d, snd ctx.local) e tv )
+ ; split = (fun d es -> ctx.split (d, snd ctx.local) es )
}
let lift_fun ctx f g = g (f (conv ctx)), snd ctx.local
- let sync ctx = let d, ds = S.sync (conv ctx) in (d, snd ctx.local), ds
+ let sync ctx reason = let d, ds = S.sync (conv ctx) reason in (d, snd ctx.local), ds
let query ctx = S.query (conv ctx)
let assign ctx lv e = lift_fun ctx S.assign ((|>) e % (|>) lv)
let vdecl ctx v = lift_fun ctx S.vdecl ((|>) v)
@@ -422,7 +423,7 @@ struct
let skip ctx = lift_fun ctx S.skip identity
let special ctx r f args = lift_fun ctx S.special ((|>) args % (|>) f % (|>) r)
- let threadenter ctx lval f args = lift_fun ctx S.threadenter ((|>) args % (|>) f % (|>) lval)
+ let threadenter ctx lval f args = S.threadenter (conv ctx) lval f args |> List.map (fun d -> (d, snd ctx.local))
let threadspawn ctx lval f args fctx = lift_fun ctx S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval)
let enter ctx r f args =
@@ -472,16 +473,16 @@ struct
let conv ctx =
{ ctx with local = D.unlift ctx.local
- ; split = (fun d e tv -> ctx.split (D.lift d) e tv )
+ ; split = (fun d es -> ctx.split (D.lift d) es )
}
let lift_fun ctx f g h b =
try f @@ h (g (conv ctx))
with Deadcode -> b
- let sync ctx =
+ let sync ctx reason =
let liftpair (x,y) = D.lift x, y in
- lift_fun ctx liftpair S.sync identity (`Bot, [])
+ lift_fun ctx liftpair S.sync ((|>) reason) (`Bot, [])
let enter ctx r f args =
let liftmap = List.map (fun (x,y) -> D.lift x, D.lift y) in
@@ -499,7 +500,7 @@ struct
let special ctx r f args = lift_fun ctx D.lift S.special ((|>) args % (|>) f % (|>) r) `Bot
let combine ctx r fe f args fc es = lift_fun ctx D.lift S.combine (fun p -> p r fe f args fc (D.unlift es)) `Bot
- let threadenter ctx lval f args = lift_fun ctx D.lift S.threadenter ((|>) args % (|>) f % (|>) lval) `Bot
+ let threadenter ctx lval f args = lift_fun ctx (List.map D.lift) S.threadenter ((|>) args % (|>) f % (|>) lval) []
let threadspawn ctx lval f args fctx = lift_fun ctx D.lift S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) `Bot
end
@@ -531,11 +532,23 @@ struct
let full_context = get_bool "exp.full-context"
(* Dummy module. No incremental analysis supported here*)
let increment = I.increment
- let common_ctx var edge prev_node pval (getl:lv -> ld) sidel getg sideg : (D.t, G.t, S.C.t) ctx * D.t list ref =
+
+ let sync ctx =
+ let (d', diff) =
+ match Cfg.prev ctx.prev_node with
+ | _ :: _ :: _ -> S.sync ctx `Join
+ | _ -> S.sync ctx `Normal
+ in
+ List.iter (uncurry ctx.sideg) diff;
+ d'
+
+ let common_ctx var edge prev_node pval (getl:lv -> ld) sidel getg sideg : (D.t, G.t, S.C.t) ctx * D.t list ref * (lval option * varinfo * exp list * D.t) list ref =
let r = ref [] in
+ let spawns = ref [] in
(* now watch this ... *)
let rec ctx =
{ ask = query
+ ; emit = (fun _ -> failwith "emit outside MCP")
; node = fst var
; prev_node = prev_node
; control_context = snd var
@@ -546,63 +559,87 @@ struct
; presub = []
; postsub = []
; spawn = spawn
- ; split = (fun (d:D.t) _ _ -> r := d::!r)
+ ; split = (fun (d:D.t) es -> assert (List.is_empty es); r := d::!r)
; sideg = sideg
; assign = (fun ?name _ -> failwith "Cannot \"assign\" in common context.")
}
and query x = S.query ctx x
and spawn lval f args =
(* TODO: adjust ctx node/edge? *)
- let d = S.threadenter ctx lval f args in
- let c = S.context d in
- let rec fctx =
- { ctx with
- ask = fquery
- ; local = d
- }
- and fquery x = S.query fctx x
- in
- r := S.threadspawn ctx lval f args fctx :: !r;
- if not full_context then sidel (FunctionEntry f, c) d;
- ignore (getl (Function f, c))
+ (* TODO: don't repeat for all paths that spawn same *)
+ let ds = S.threadenter ctx lval f args in
+ List.iter (fun d ->
+ let c = S.context d in
+ spawns := (lval, f, args, d) :: !spawns;
+ if not full_context then sidel (FunctionEntry f, c) d;
+ ignore (getl (Function f, c))
+ ) ds
in
(* ... nice, right! *)
- let pval, diff = S.sync ctx in
- let _ = List.iter (uncurry sideg) diff in
- { ctx with local = pval }, r
+ let pval = sync ctx in
+ { ctx with local = pval }, r, spawns
let rec bigsqcup = function
| [] -> D.bot ()
| [x] -> x
| x::xs -> D.join x (bigsqcup xs)
+ let thread_spawns ctx d spawns =
+ if List.is_empty spawns then
+ d
+ else
+ let rec ctx' =
+ { ctx with
+ ask = query'
+ ; local = d
+ }
+ and query' x = S.query ctx' x
+ in
+ (* TODO: don't forget path dependencies *)
+ let one_spawn (lval, f, args, fd) =
+ let rec fctx =
+ { ctx with
+ ask = fquery
+ ; local = fd
+ }
+ and fquery x = S.query fctx x
+ in
+ S.threadspawn ctx' lval f args fctx
+ in
+ bigsqcup (List.map one_spawn spawns)
+
+ let common_join ctx d splits spawns =
+ thread_spawns ctx (bigsqcup (d :: splits)) spawns
+
+ let common_joins ctx ds splits spawns = common_join ctx (bigsqcup ds) splits spawns
+
let tf_loop var edge prev_node getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
- bigsqcup ((S.intrpt ctx)::!r)
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
+ common_join ctx (S.intrpt ctx) !r !spawns
let tf_assign var edge prev_node lv e getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
- bigsqcup ((S.assign ctx lv e)::!r)
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
+ common_join ctx (S.assign ctx lv e) !r !spawns
let tf_vdecl var edge prev_node v getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
- bigsqcup ((S.vdecl ctx v)::!r)
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
+ common_join ctx (S.vdecl ctx v) !r !spawns
let normal_return r fd ctx sideg =
let spawning_return = S.return ctx r fd in
- let nval, ndiff = S.sync { ctx with local = spawning_return } in
+ let nval, ndiff = S.sync { ctx with local = spawning_return } `Return in
List.iter (fun (x,y) -> sideg x y) ndiff;
nval
let toplevel_kernel_return r fd ctx sideg =
let st = if fd.svar.vname = MyCFG.dummy_func.svar.vname then ctx.local else S.return ctx r fd in
let spawning_return = S.return {ctx with local = st} None MyCFG.dummy_func in
- let nval, ndiff = S.sync { ctx with local = spawning_return } in
+ let nval, ndiff = S.sync { ctx with local = spawning_return } `Return in
List.iter (fun (x,y) -> sideg x y) ndiff;
nval
let tf_ret var edge prev_node ret fd getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
let d =
if (fd.svar.vid = MyCFG.dummy_func.svar.vid ||
List.mem fd.svar.vname (List.map Json.string (get_list "mainfun"))) &&
@@ -610,30 +647,53 @@ struct
then toplevel_kernel_return ret fd ctx sideg
else normal_return ret fd ctx sideg
in
- bigsqcup (d::!r)
+ common_join ctx d !r !spawns
let tf_entry var edge prev_node fd getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
- bigsqcup ((S.body ctx fd)::!r)
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
+ common_join ctx (S.body ctx fd) !r !spawns
let tf_test var edge prev_node e tv getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
- bigsqcup ((S.branch ctx e tv)::!r)
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
+ common_join ctx (S.branch ctx e tv) !r !spawns
let tf_normal_call ctx lv e f args getl sidel getg sideg =
- let combine (cd, fc, fd) = S.combine {ctx with local = cd} lv e f args fc fd in
+ let combine (cd, fc, fd) =
+ if M.tracing then M.traceli "combine" "local: %a\n" S.D.pretty cd;
+ (* Extra sync in case function has multiple returns.
+ Each `Return sync is done before joining, so joined value may be unsound.
+ Since sync is normally done before tf (in common_ctx), simulate it here for fd. *)
+ (* TODO: don't do this extra sync here *)
+ let fd =
+ (* TODO: more accurate ctx? *)
+ let rec sync_ctx = { ctx with
+ ask = query;
+ local = fd;
+ prev_node = Function f
+ }
+ and query x = S.query sync_ctx x
+ in
+ sync sync_ctx
+ in
+ let r = S.combine {ctx with local = cd} lv e f args fc fd in
+ if M.tracing then M.traceu "combine" "combined local: %a\n" S.D.pretty r;
+ r
+ in
let paths = S.enter ctx lv f args in
let paths = List.map (fun (c,v) -> (c, S.context v, v)) paths in
let _ = if not full_context then List.iter (fun (c,fc,v) -> if not (S.D.is_bot v) then sidel (FunctionEntry f, fc) v) paths in
let paths = List.map (fun (c,fc,v) -> (c, fc, if S.D.is_bot v then v else getl (Function f, fc))) paths in
let paths = List.filter (fun (c,fc,v) -> not (D.is_bot v)) paths in
+ if M.tracing then M.traceli "combine" "combining\n";
let paths = List.map combine paths in
- List.fold_left D.join (D.bot ()) paths
+ let r = List.fold_left D.join (D.bot ()) paths in
+ if M.tracing then M.traceu "combine" "combined: %a\n" S.D.pretty r;
+ r
let tf_special_call ctx lv f args = S.special ctx lv f args
let tf_proc var edge prev_node lv e args getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
let functions =
match ctx.ask (Queries.EvalFunvar e) with
| `LvalSet ls -> Queries.LS.fold (fun ((x,_)) xs -> x::xs) ls []
@@ -642,23 +702,30 @@ struct
in
let one_function f =
let has_dec = try ignore (Cilfacade.getdec f); true with Not_found -> false in
- if has_dec && not (LibraryFunctions.use_special f.vname)
- then tf_normal_call ctx lv e f args getl sidel getg sideg
- else tf_special_call ctx lv f args
+ if has_dec then (
+ if LibraryFunctions.use_special f.vname then (
+ M.warn_each ("Using special for defined function " ^ f.vname);
+ tf_special_call ctx lv f args
+ )
+ else
+ tf_normal_call ctx lv e f args getl sidel getg sideg
+ )
+ else
+ tf_special_call ctx lv f args
in
if [] = functions then
d (* because LevelSliceLifter *)
else
let funs = List.map one_function functions in
- bigsqcup (funs @ !r)
+ common_joins ctx funs !r !spawns
let tf_asm var edge prev_node getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
- bigsqcup ((S.asm ctx)::!r)
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
+ common_join ctx (S.asm ctx) !r !spawns
let tf_skip var edge prev_node getl sidel getg sideg d =
- let ctx, r = common_ctx var edge prev_node d getl sidel getg sideg in
- bigsqcup ((S.skip ctx)::!r)
+ let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in
+ common_join ctx (S.skip ctx) !r !spawns
let tf var getl sidel getg sideg prev_node edge d =
begin match edge with
@@ -906,11 +973,11 @@ struct
try
let p t = not (mem t s2) in
let evil = choose (filter p s1) in
- let other = choose s2 in
- (* dprintf "%s has a problem with %a not leq %a because %a" (name ())
- Spec.D.pretty evil Spec.D.pretty other
- Spec.D.pretty_diff (evil,other) *)
- Spec.D.pretty_diff () (evil,other)
+ dprintf "%a:\n" Spec.D.pretty evil
+ ++
+ fold (fun other acc ->
+ (dprintf "not leq %a because %a\n" Spec.D.pretty other Spec.D.pretty_diff (evil, other)) ++ acc
+ ) s2 nil
with _ ->
dprintf "choose failed b/c of empty set s1: %d s2: %d"
(cardinal s1)
@@ -987,21 +1054,6 @@ struct
let d = D.fold h ctx.local (D.empty ()) in
if D.is_bot d then raise Deadcode else d
- let assign ctx l e = map ctx Spec.assign (fun h -> h l e )
- let vdecl ctx v = map ctx Spec.vdecl (fun h -> h v)
- let body ctx f = map ctx Spec.body (fun h -> h f )
- let return ctx e f = map ctx Spec.return (fun h -> h e f )
- let branch ctx e tv = map ctx Spec.branch (fun h -> h e tv)
- let intrpt ctx = map ctx Spec.intrpt identity
- let asm ctx = map ctx Spec.asm identity
- let skip ctx = map ctx Spec.skip identity
- let special ctx l f a = map ctx Spec.special (fun h -> h l f a)
-
- let threadenter ctx lval f args = map ctx Spec.threadenter (fun h -> h lval f args)
- let threadspawn ctx lval f args fctx =
- let fd1 = D.choose fctx.local in
- map ctx Spec.threadspawn (fun h -> h lval f args (conv fctx fd1))
-
let fold ctx f g h a =
let k x a =
try h a @@ g @@ f @@ conv ctx x
@@ -1017,8 +1069,25 @@ struct
in
D.fold k ctx.local a
- let sync ctx =
- fold' ctx Spec.sync identity (fun (a,b) (a',b') -> D.add a' a, b'@b) (D.empty (), [])
+ let assign ctx l e = map ctx Spec.assign (fun h -> h l e )
+ let vdecl ctx v = map ctx Spec.vdecl (fun h -> h v)
+ let body ctx f = map ctx Spec.body (fun h -> h f )
+ let return ctx e f = map ctx Spec.return (fun h -> h e f )
+ let branch ctx e tv = map ctx Spec.branch (fun h -> h e tv)
+ let intrpt ctx = map ctx Spec.intrpt identity
+ let asm ctx = map ctx Spec.asm identity
+ let skip ctx = map ctx Spec.skip identity
+ let special ctx l f a = map ctx Spec.special (fun h -> h l f a)
+
+ let threadenter ctx lval f args =
+ let g xs ys = (List.map (fun y -> D.singleton y) ys) @ xs in
+ fold' ctx Spec.threadenter (fun h -> h lval f args) g []
+ let threadspawn ctx lval f args fctx =
+ let fd1 = D.choose fctx.local in
+ map ctx Spec.threadspawn (fun h -> h lval f args (conv fctx fd1))
+
+ let sync ctx reason =
+ fold' ctx Spec.sync (fun h -> h reason) (fun (a,b) (a',b') -> D.add a' a, b'@b) (D.empty (), [])
let query ctx q =
(* join results so that they are sound for all paths *)
@@ -1032,8 +1101,14 @@ struct
assert (D.cardinal ctx.local = 1);
let cd = D.choose ctx.local in
let k x y =
- try D.add (Spec.combine (conv ctx cd) l fe f a fc x) y
- with Deadcode -> y
+ if M.tracing then M.traceli "combine" "function: %a\n" Spec.D.pretty x;
+ try
+ let r = Spec.combine (conv ctx cd) l fe f a fc x in
+ if M.tracing then M.traceu "combine" "combined function: %a\n" Spec.D.pretty r;
+ D.add r y
+ with Deadcode ->
+ if M.tracing then M.traceu "combine" "combined function: dead\n";
+ y
in
let d = D.fold k d (D.bot ()) in
if D.is_bot d then raise Deadcode else d
diff --git a/src/framework/control.ml b/src/framework/control.ml
index c9f83344d1..44c9409954 100644
--- a/src/framework/control.ml
+++ b/src/framework/control.ml
@@ -86,6 +86,13 @@ struct
);
in
Result.iter add_one xs;
+ let live_count = StringMap.fold (fun _ file_lines acc ->
+ StringMap.fold (fun _ fun_lines acc ->
+ acc + ISet.cardinal fun_lines
+ ) file_lines acc
+ ) !live_lines 0
+ in
+ printf "Live lines: %d\n" live_count;
let live file fn =
try StringMap.find fn (StringMap.find file !live_lines)
with Not_found -> BatISet.empty
@@ -190,18 +197,23 @@ struct
foldGlobals file add_externs (Spec.startstate MyCFG.dummy_func.svar)
in
+ (* Simulate globals before analysis. *)
+ (* TODO: make extern/global inits part of constraint system so all of this would be unnecessary. *)
+ let gh = GHT.create 13 in
+ let getg v = GHT.find_default gh v (Spec.G.bot ()) in
+ let sideg v d =
+ if M.tracing then M.trace "global_inits" "sideg %a = %a\n" Prelude.Ana.d_varinfo v Spec.G.pretty d;
+ GHT.replace gh v (Spec.G.join (getg v) d)
+ in
+ (* Old-style global function for context.
+ * This indirectly prevents global initializers from depending on each others' global side effects, which would require proper solving. *)
+ let getg v = Spec.G.bot () in
+
(* analyze cil's global-inits function to get a starting state *)
- let do_global_inits (file: file) : Spec.D.t * fundec list * (varinfo * Spec.G.t) list =
- (* Simulate globals before analysis. *)
- (* TODO: make extern/global inits part of constraint system so all of this would be unnecessary. *)
- let gh = GHT.create 13 in
- let getg v = GHT.find_default gh v (Spec.G.bot ()) in
- let sideg v d = GHT.replace gh v (Spec.G.join (getg v) d) in
- (* Old-style global function for context.
- * This indirectly prevents global initializers from depending on each others' global side effects, which would require proper solving. *)
- let getg v = Spec.G.bot () in
+ let do_global_inits (file: file) : Spec.D.t * fundec list =
let ctx =
{ ask = (fun _ -> Queries.Result.top ())
+ ; emit = (fun _ -> failwith "Cannot \"emit\" in global initializer context.")
; node = MyCFG.dummy_node
; prev_node = MyCFG.dummy_node
; control_context = Obj.repr (fun () -> ctx_failwith "Global initializers have no context.")
@@ -244,7 +256,8 @@ struct
let with_externs = do_extern_inits ctx file in
(*if (get_bool "dbg.verbose") then Printf.printf "Number of init. edges : %d\nWorking:" (List.length edges); *)
let result : Spec.D.t = List.fold_left transfer_func with_externs edges in
- result, !funs, GHT.to_list gh
+ if M.tracing then M.trace "global_inits" "startstate: %a\n" Spec.D.pretty result;
+ result, !funs
in
let print_globals glob =
@@ -260,7 +273,7 @@ struct
WResult.init file; (* TODO: move this out of analyze_loop *)
GU.global_initialization := true;
- GU.earlyglobs := false;
+ GU.earlyglobs := get_bool "exp.earlyglobs";
Spec.init ();
Access.init file;
@@ -279,7 +292,7 @@ struct
)
in
- let startstate, more_funs, entrystates_global =
+ let startstate, more_funs =
if (get_bool "dbg.verbose") then print_endline ("Initializing "^string_of_int (MyCFG.numGlobals file)^" globals.");
Stats.time "global_inits" do_global_inits file
in
@@ -290,18 +303,19 @@ struct
let st = st fd.svar in
let ctx =
{ ask = (fun _ -> Queries.Result.top ())
+ ; emit = (fun _ -> failwith "Cannot \"emit\" in enter_with context.")
; node = MyCFG.dummy_node
; prev_node = MyCFG.dummy_node
; control_context = Obj.repr (fun () -> ctx_failwith "enter_func has no context.")
; context = (fun () -> ctx_failwith "enter_func has no context.")
; edge = MyCFG.Skip
; local = st
- ; global = (fun _ -> Spec.G.bot ())
+ ; global = getg
; presub = []
; postsub = []
; spawn = (fun _ -> failwith "Bug1: Using enter_func for toplevel functions with 'otherstate'.")
; split = (fun _ -> failwith "Bug2: Using enter_func for toplevel functions with 'otherstate'.")
- ; sideg = (fun _ -> failwith "Bug3: Using enter_func for toplevel functions with 'otherstate'.")
+ ; sideg = sideg
; assign = (fun ?name _ -> failwith "Bug4: Using enter_func for toplevel functions with 'otherstate'.")
}
in
@@ -324,22 +338,24 @@ struct
let otherstate st v =
let ctx =
{ ask = (fun _ -> Queries.Result.top ())
+ ; emit = (fun _ -> failwith "Cannot \"emit\" in otherstate context.")
; node = MyCFG.dummy_node
; prev_node = MyCFG.dummy_node
; control_context = Obj.repr (fun () -> ctx_failwith "enter_func has no context.")
; context = (fun () -> ctx_failwith "enter_func has no context.")
; edge = MyCFG.Skip
; local = st
- ; global = (fun _ -> Spec.G.bot ())
+ ; global = getg
; presub = []
; postsub = []
; spawn = (fun _ -> failwith "Bug1: Using enter_func for toplevel functions with 'otherstate'.")
; split = (fun _ -> failwith "Bug2: Using enter_func for toplevel functions with 'otherstate'.")
- ; sideg = (fun _ -> failwith "Bug3: Using enter_func for toplevel functions with 'otherstate'.")
+ ; sideg = sideg
; assign = (fun ?name _ -> failwith "Bug4: Using enter_func for toplevel functions with 'otherstate'.")
}
in
- Spec.threadenter ctx None v []
+ (* TODO: don't hd *)
+ List.hd (Spec.threadenter ctx None v [])
(* TODO: do threadspawn to mainfuns? *)
in
let prestartstate = Spec.startstate MyCFG.dummy_func.svar in (* like in do_extern_inits *)
@@ -348,7 +364,6 @@ struct
if startvars = [] then
failwith "BUG: Empty set of start variables; may happen if enter_func of any analysis returns an empty list.";
- GU.earlyglobs := get_bool "exp.earlyglobs";
GU.global_initialization := false;
let startvars' =
@@ -359,6 +374,7 @@ struct
in
let entrystates = List.map (fun (n,e) -> (MyCFG.FunctionEntry n, Spec.context e), e) startvars in
+ let entrystates_global = GHT.to_list gh in
let solve_and_postprocess () =
(* handle save_run/load_run *)
@@ -485,6 +501,7 @@ struct
(* build a ctx for using the query system *)
let rec ctx =
{ ask = query
+ ; emit = (fun _ -> failwith "Cannot \"emit\" in query context.")
; node = MyCFG.dummy_node (* TODO maybe ask should take a node (which could be used here) instead of a location *)
; prev_node = MyCFG.dummy_node
; control_context = Obj.repr (fun () -> ctx_failwith "No context in query context.")
@@ -495,7 +512,7 @@ struct
; presub = []
; postsub= []
; spawn = (fun v d -> failwith "Cannot \"spawn\" in query context.")
- ; split = (fun d e tv -> failwith "Cannot \"split\" in query context.")
+ ; split = (fun d es -> failwith "Cannot \"split\" in query context.")
; sideg = (fun v g -> failwith "Cannot \"split\" in query context.")
; assign = (fun ?name _ -> failwith "Cannot \"assign\" in query context.")
}
diff --git a/src/maindomaintest.ml b/src/maindomaintest.ml
index 76396468f9..dd776c4600 100644
--- a/src/maindomaintest.ml
+++ b/src/maindomaintest.ml
@@ -60,7 +60,8 @@ let domains: (module Lattice.S) list = [
(module ArbitraryLattice);
(module HoareArbitrary);
- (module WitnessConstraints.HoareMap (ArbitraryLattice) (HoareArbitrary))
+ (* TODO: fix after traces *)
+ (* (module WitnessConstraints.HoareMap (ArbitraryLattice) (HoareArbitrary)) *)
]
let nonAssocDomains: (module Lattice.S) list = []
diff --git a/src/maingoblint.ml b/src/maingoblint.ml
index eeba781ec2..cea4e1e03c 100644
--- a/src/maingoblint.ml
+++ b/src/maingoblint.ml
@@ -278,7 +278,7 @@ let merge_preprocessed cpp_file_names =
(* create the Control Flow Graph from CIL's AST *)
Cilfacade.createCFG merged_AST;
- Cilfacade.ugglyImperativeHack := merged_AST;
+ Cilfacade.current_file := merged_AST;
merged_AST
(** Perform the analysis over the merged AST. *)
@@ -311,7 +311,7 @@ let do_analyze change_info merged_AST =
let loc = !Tracing.current_loc in
Printf.printf "About to crash on %s:%d\n" loc.Cil.file loc.Cil.line;
raise x
- (* Cilfacade.ugglyImperativeHack := ast'; *)
+ (* Cilfacade.current_file := ast'; *)
in
(* old style is ana.activated = [phase_1, ...] with phase_i = [ana_1, ...]
new style (Goblintutil.phase_config = true) is phases[i].ana.activated = [ana_1, ...]
@@ -355,7 +355,8 @@ let check_arguments () =
let ctx_insens = Set.(cardinal (intersect (of_list (get_list "ana.ctx_insens")) (of_list (get_list "ana.activated")))) > 0 in
if ctx_insens && get_bool "exp.full-context" then warn "exp.full-context might lead to exceptions (undef. operations on top) with context-insensitive analyses enabled (ana.ctx_insens)";
if get_bool "allfuns" && not (get_bool "exp.earlyglobs") then (set_bool "exp.earlyglobs" true; warn "allfuns enables exp.earlyglobs.\n");
- if not @@ List.mem "escape" @@ get_string_list "ana.activated" then warn "Without thread escape analysis, every local variable whose address is taken is considered escaped, i.e., global!"
+ if not @@ List.mem "escape" @@ get_string_list "ana.activated" then warn "Without thread escape analysis, every local variable whose address is taken is considered escaped, i.e., global!";
+ if get_string "ana.osek.oil" <> "" && not (get_string "exp.privatization" = "protection-vesal" || get_string "exp.privatization" = "protection-old") then (set_string "exp.privatization" "protection-vesal"; warn "oil requires protection-old/protection-vesal privatization")
let handle_extraspecials () =
let f xs = function
@@ -433,6 +434,7 @@ let main =
Stats.reset Stats.SoftwareTimer;
parse_arguments ();
check_arguments ();
+ AfterConfig.run ();
(* Cil.lowerConstants assumes wrap-around behavior for signed intger types, which conflicts with checking
for overflows, as this will replace potential overflows with constants after wrap-around *)
diff --git a/src/privPrecCompare.ml b/src/privPrecCompare.ml
new file mode 100644
index 0000000000..3fe596cde0
--- /dev/null
+++ b/src/privPrecCompare.ml
@@ -0,0 +1,112 @@
+open! Defaults (* CircInterval / Enums / ... need initialized conf *)
+open! Batteries
+open Prelude
+open Ana
+open PrivPrecCompareUtil
+
+module VD = BaseDomain.VD
+
+let load filename =
+ let f = open_in_bin filename in
+ let dump: dump = Marshal.from_channel f in
+ close_in_noerr f;
+ dump
+
+module Comparison =
+struct
+ type t =
+ | Equal
+ | MorePrecise of int
+ | LessPrecise of int
+ | Incomparable of int * int
+
+ let aggregate_same c1 c2 = match c1, c2 with
+ | Incomparable (m1, l1), Incomparable (m2, l2) ->
+ Incomparable (m1 + m2, l1 + l2)
+ | Incomparable (m1, l), MorePrecise m2
+ | MorePrecise m2, Incomparable (m1, l) ->
+ Incomparable (m1 + m2, l)
+ | Incomparable (m, l1), LessPrecise l2
+ | LessPrecise l2, Incomparable (m, l1) ->
+ Incomparable (m, l1 + l2)
+ | MorePrecise m, LessPrecise l
+ | LessPrecise l, MorePrecise m ->
+ Incomparable (m, l)
+ | Equal, c
+ | c, Equal ->
+ c
+ | MorePrecise m1, MorePrecise m2 ->
+ MorePrecise (m1 + m2)
+ | LessPrecise l1, LessPrecise l2 ->
+ LessPrecise (l1 + l2)
+
+ let to_string_infix = function
+ | Equal -> "equal to"
+ | MorePrecise _ -> "more precise than"
+ | LessPrecise _ -> "less precise than"
+ | Incomparable _ -> "incomparable to"
+
+ let counts = function
+ | Equal -> (0, 0)
+ | MorePrecise m -> (m, 0)
+ | LessPrecise l -> (0, l)
+ | Incomparable (m, l) -> (m, l)
+end
+
+
+let compare_dumps {name = name1; lvh = lvh1} {name = name2; lvh = lvh2} =
+ let lvh = LVH.merge (fun k v1 v2 -> Some (v1, v2)) lvh1 lvh2 in
+ let compared = LVH.map (fun (l, x) (v1, v2) ->
+ let v1 = v1 |? VD.bot () in
+ let v2 = v2 |? VD.bot () in
+ let c = match VD.leq v1 v2, VD.leq v2 v1 with
+ | true, true -> Comparison.Equal
+ | true, false -> Comparison.MorePrecise 1
+ | false, true -> Comparison.LessPrecise 1
+ | false, false -> Comparison.Incomparable (1, 1)
+ in
+ let diff () =
+ (if VD.leq v1 v2 then nil else dprintf "diff: %a\n" VD.pretty_diff (v1, v2))
+ ++
+ (if VD.leq v2 v1 then nil else dprintf "reverse diff: %a\n" VD.pretty_diff (v2, v1))
+ in
+ let msg = Pretty.dprintf "%s %s %s\n @[%s: %a\n%s\n%s: %a\n%t@]" name1 (Comparison.to_string_infix c) name2 name1 VD.pretty v1 (Comparison.to_string_infix c) name2 VD.pretty v2 diff in
+ (c, msg)
+ ) lvh
+ in
+ LVH.iter (fun (l, x) (c, msg) ->
+ match c with
+ | Comparison.Equal -> ()
+ | _ ->
+ ignore (Pretty.printf "%a %a: %t\n" d_loc l d_varinfo x (fun () -> msg))
+ ) compared;
+ let c = LVH.fold (fun _ (c, _) acc -> Comparison.aggregate_same c acc) compared Comparison.Equal in
+ let (m, l) = Comparison.counts c in
+ let msg = Pretty.dprintf "%s %s %s (more precise: %d, less precise: %d, total: %d)" name1 (Comparison.to_string_infix c) name2 m l (LVH.length lvh) in
+ (c, msg)
+
+let count_locations dumps =
+ let module LH = Hashtbl.Make (Basetype.ProgLines) in
+ let locations = LH.create 113 in
+ let location_vars = LVH.create 113 in
+ List.iter (fun {lvh; _} ->
+ LVH.iter (fun (l, x) _ ->
+ LH.replace locations l ();
+ LVH.replace location_vars (l, x) ()
+ ) lvh
+ ) dumps;
+ (LH.length locations, LVH.length location_vars)
+
+let () =
+ Cil.initCIL (); (* ValueDomain.Compound.leq depends on ptrdiffType initialization *)
+ let filenames = List.tl (Array.to_list Sys.argv) in
+ let dumps = List.map load filenames in
+ let (locations_count, location_vars_count) = count_locations dumps in
+ let i_dumps = List.mapi (fun i dump -> (i, dump)) dumps in
+ List.cartesian_product i_dumps i_dumps
+ (* |> List.filter (fun ((i1, _), (i2, _)) -> i1 < i2) *)
+ |> List.filter (fun ((i1, _), (i2, _)) -> i1 <> i2)
+ |> List.map (Tuple2.map snd snd)
+ |> List.map (uncurry compare_dumps)
+ |> List.iter (fun (_, msg) -> ignore (Pretty.printf "%t\n" (fun () -> msg)));
+ ignore (Pretty.printf "\nTotal locations: %d\nTotal location variables: %d\n" locations_count location_vars_count)
\ No newline at end of file
diff --git a/src/solvers/td3.ml b/src/solvers/td3.ml
index dae1e9d4b0..e13e00d2c6 100644
--- a/src/solvers/td3.ml
+++ b/src/solvers/td3.ml
@@ -161,7 +161,12 @@ module WP =
);
assert (S.system y = None);
init y;
- let op = if HM.mem wpoint y then fun a b -> S.Dom.widen a (S.Dom.join a b) else S.Dom.join in
+ let op = if HM.mem wpoint y then fun a b ->
+ if M.tracing then M.traceli "sol2" "side widen %a %a\n" S.Dom.pretty a S.Dom.pretty b;
+ let r = S.Dom.widen a (S.Dom.join a b) in
+ if M.tracing then M.traceu "sol2" "-> %a\n" S.Dom.pretty r;
+ r
+ else S.Dom.join in
let old = HM.find rho y in
let tmp = op old d in
HM.replace stable y ();
diff --git a/src/util/afterConfig.ml b/src/util/afterConfig.ml
new file mode 100644
index 0000000000..a49e4f31cc
--- /dev/null
+++ b/src/util/afterConfig.ml
@@ -0,0 +1,8 @@
+let callbacks = ref []
+
+let register callback =
+ callbacks := callback :: !callbacks
+
+let run () =
+ List.iter (fun callback -> callback ()) !callbacks;
+ callbacks := []
\ No newline at end of file
diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml
index dd556b2ac1..8d5a9817e8 100644
--- a/src/util/cilfacade.ml
+++ b/src/util/cilfacade.ml
@@ -16,8 +16,8 @@ let init () =
Rmtmps.keepUnused := true;
print_CIL_Input := true
-let currentStatement = ref dummyStmt
-let ugglyImperativeHack = ref dummyFile
+let current_statement = ref dummyStmt
+let current_file = ref dummyFile
let showtemps = ref false
let parse fileName =
@@ -151,7 +151,7 @@ let callConstructors ast =
exception Found of fundec
let getFun fun_name =
try
- iterGlobals !ugglyImperativeHack (fun glob ->
+ iterGlobals !current_file (fun glob ->
match glob with
| GFun({svar={vname=vn; _}; _} as def,_) when vn = fun_name -> raise (Found def)
| _ -> ()
@@ -218,7 +218,7 @@ let dec_table = Hashtbl.create 111
let dec_make () : unit =
dec_table_ok := true ;
Hashtbl.clear dec_table;
- iterGlobals !ugglyImperativeHack (fun glob ->
+ iterGlobals !current_file (fun glob ->
match glob with
| GFun({svar={vid=vid; _}; _} as def,_) -> Hashtbl.add dec_table vid def
| _ -> ()
diff --git a/src/util/defaults.ml b/src/util/defaults.ml
index 48ab237e97..4803a481cf 100644
--- a/src/util/defaults.ml
+++ b/src/util/defaults.ml
@@ -9,6 +9,7 @@ open List
(** Main categories of configuration variables. *)
type category = Std (** Parsing input, includes, standard stuff, etc. *)
| Analyses (** Analyses *)
+ | Semantics (** Semantics *)
| Transformations (** Transformations *)
| Experimental (** Experimental features of analyses *)
| Debugging (** Debugging, tracing, etc. *)
@@ -17,6 +18,7 @@ type category = Std (** Parsing input, includes, standard stuff, etc
let catDescription = function
| Std -> "Standard options for configuring input/output"
| Analyses -> "Options for analyses"
+ | Semantics -> "Options for semantics"
| Transformations -> "Options for transformations"
| Experimental -> "Experimental features"
| Debugging -> "Debugging options"
@@ -134,6 +136,13 @@ let _ = ()
; reg Analyses "ana.specification" "" "SV-COMP specification (path or string)"
; reg Analyses "ana.wp" "false" "Weakest precondition feasibility analysis for SV-COMP violations"
+(* {4 category [Semantics]} *)
+let _ = ()
+ (* TODO: split unknown_function to undefined_function and unknown_function_ptr *)
+ ; reg Semantics "sem.unknown_function.spawn" "true" "Unknown function call spawns reachable functions"
+ ; reg Semantics "sem.unknown_function.invalidate.globals" "true" "Unknown function call invalidates all globals"
+ ; reg Semantics "sem.builtin_unreachable.dead_code" "false" "__builtin_unreachable is assumed to be dead code"
+
(* {4 category [Transformations]} *)
let _ = ()
; reg Transformations "trans.activated" "[]" "Lists of activated transformations in this phase. Transformations happen after analyses."
@@ -142,7 +151,10 @@ let _ = ()
(* {4 category [Experimental]} *)
let _ = ()
; reg Experimental "exp.lower-constants" "true" "Use Cil.lowerConstants to simplify some constant? (assumes wrap-around for signed int)"
- ; reg Experimental "exp.privatization" "true" "Use privatization?"
+ (* TODO: priv subobject *)
+ ; reg Experimental "exp.privatization" "'protection-read'" "Which privatization to use? none/protection-old/mutex-oplus/mutex-meet/protection/protection-read/protection-vesal/mine/mine-nothread/mine-W/mine-W-noinit/lock/write/write+lock"
+ ; reg Experimental "exp.priv-prec-dump" "''" "File to dump privatization precision data to."
+ ; reg Experimental "exp.priv-distr-init" "false" "Distribute global initializations to all global invariants for more consistent widening dynamics."
; reg Experimental "exp.cfgdot" "false" "Output CFG to dot files"
; reg Experimental "exp.mincfg" "false" "Try to minimize the number of CFG nodes."
; reg Experimental "exp.earlyglobs" "false" "Side-effecting of globals right after initialization."
@@ -159,7 +171,6 @@ let _ = ()
; reg Experimental "exp.volatiles_are_top" "true" "volatile and extern keywords set variables permanently to top"
; reg Experimental "exp.single-threaded" "false" "Ensures analyses that no threads are created."
; reg Experimental "exp.globs_are_top" "false" "Set globals permanently to top."
- ; reg Experimental "exp.unknown_funs_spawn" "true" "Should unknown function calls spawn reachable functions and switch to MT-mode?"
; reg Experimental "exp.precious_globs" "[]" "Global variables that should be handled flow-sensitively when using earlyglobs."
; reg Experimental "exp.list-type" "false" "Use a special abstract value for lists."
; reg Experimental "exp.g2html_path" "'.'" "Location of the g2html.jar file."
@@ -224,6 +235,7 @@ let default_schema = "\
, 'additionalProps' : true
, 'required' : []
}
+ , 'sem' : {}
, 'trans' : {}
, 'phases' : {}
, 'exp' :
diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml
index 46030e809d..316bbe981e 100644
--- a/src/util/goblintutil.ml
+++ b/src/util/goblintutil.ml
@@ -84,9 +84,7 @@ let escape (x:string):string =
Str.global_replace (Str.regexp ">") ">" |>
Str.global_replace (Str.regexp "\"") """ |>
Str.global_replace (Str.regexp "'") "'" |>
- Str.global_replace (Str.regexp "\x0b") "" |> (* g2html just cannot handle \v from some kernel benchmarks, even when escaped... *)
- Str.global_replace (Str.regexp "\001") "" |> (* g2html just cannot handle \v from some kernel benchmarks, even when escaped... *)
- Str.global_replace (Str.regexp "\x0c") "" (* g2html just cannot handle \v from some kernel benchmarks, even when escaped... *)
+ Str.global_replace (Str.regexp "[\x0b\001\x0c\x0f\x0e]") "" (* g2html just cannot handle from some kernel benchmarks, even when escaped... *)
let trim (x:string): string =
let len = String.length x in
diff --git a/src/util/privPrecCompareUtil.ml b/src/util/privPrecCompareUtil.ml
new file mode 100644
index 0000000000..3909267d85
--- /dev/null
+++ b/src/util/privPrecCompareUtil.ml
@@ -0,0 +1,9 @@
+open Prelude
+
+module LVH = Hashtbl.Make (Printable.Prod (Basetype.ProgLines) (Basetype.Variables))
+module VD = BaseDomain.VD
+
+type dump = {
+ name: string;
+ lvh: VD.t LVH.t;
+}
\ No newline at end of file
diff --git a/src/util/richVarinfo.ml b/src/util/richVarinfo.ml
new file mode 100644
index 0000000000..0c059f46b5
--- /dev/null
+++ b/src/util/richVarinfo.ml
@@ -0,0 +1,33 @@
+open Cil
+
+let create_var name = Goblintutil.create_var @@ makeGlobalVar name voidType
+
+let single ~name =
+ let vi = lazy (create_var name) in
+ fun () ->
+ Lazy.force vi
+
+module type S =
+sig
+ type t
+ val map: name:(t -> string) -> ?size:int -> (t -> varinfo)
+end
+
+module Make (X: Hashtbl.HashedType) =
+struct
+ module XH = Hashtbl.Make (X)
+
+ type t = X.t
+
+ let map ~name ?(size=13) =
+ let xh = XH.create size in
+ fun x ->
+ try
+ XH.find xh x
+ with Not_found ->
+ let vi = create_var (name x) in
+ XH.replace xh x vi;
+ vi
+end
+
+module Variables = Make (Basetype.Variables)
\ No newline at end of file
diff --git a/src/util/richVarinfo.mli b/src/util/richVarinfo.mli
new file mode 100644
index 0000000000..2f066d7965
--- /dev/null
+++ b/src/util/richVarinfo.mli
@@ -0,0 +1,15 @@
+open Cil
+
+val single: name:string -> (unit -> varinfo)
+
+module type S =
+sig
+ type t
+ val map: name:(t -> string) -> ?size:int -> (t -> varinfo)
+end
+
+module Make:
+ functor (X: Hashtbl.HashedType) ->
+ S with type t = X.t
+
+module Variables: S with type t = varinfo
\ No newline at end of file
diff --git a/src/witness/observerAnalysis.ml b/src/witness/observerAnalysis.ml
index 3ee82c97a7..7bbc99752f 100644
--- a/src/witness/observerAnalysis.ml
+++ b/src/witness/observerAnalysis.ml
@@ -14,7 +14,7 @@ let get_fresh_spec_id =
return_id
(* TODO: relax q type *)
-module MakeSpec (Automaton: StepObserverAutomaton with type q = int) : Analyses.Spec =
+module MakeSpec (Automaton: StepObserverAutomaton with type q = int) : Analyses.MCPSpec =
struct
include Analyses.DefaultSpec
@@ -73,8 +73,8 @@ struct
step_ctx ctx
let startstate v = `Lifted Automaton.initial
- let threadenter ctx lval f args = D.top ()
- let threadspawn ctx lval f args fctx = D.bot ()
+ let threadenter ctx lval f args = [D.top ()]
+ let threadspawn ctx lval f args fctx = ctx.local
let exitstate v = D.top ()
end
@@ -84,7 +84,7 @@ sig
val path: (node * node) list
end
-module MakePathSpec (Arg: PathArg) : Analyses.Spec =
+module MakePathSpec (Arg: PathArg) : Analyses.MCPSpec =
struct
module KMP = ObserverAutomaton.KMP (
struct
diff --git a/src/witness/witness.ml b/src/witness/witness.ml
index 5e81b982eb..0c5464e868 100644
--- a/src/witness/witness.ml
+++ b/src/witness/witness.ml
@@ -309,6 +309,7 @@ struct
(* build a ctx for using the query system *)
let rec ctx =
{ ask = query
+ ; emit = (fun _ -> failwith "Cannot \"emit\" in witness context.")
; node = fst lvar
; prev_node = MyCFG.dummy_node
; control_context = Obj.repr (fun () -> snd lvar)
@@ -319,7 +320,7 @@ struct
; presub = []
; postsub= []
; spawn = (fun v d -> failwith "Cannot \"spawn\" in witness context.")
- ; split = (fun d e tv -> failwith "Cannot \"split\" in witness context.")
+ ; split = (fun d es -> failwith "Cannot \"split\" in witness context.")
; sideg = (fun v g -> failwith "Cannot \"sideg\" in witness context.")
; assign = (fun ?name _ -> failwith "Cannot \"assign\" in witness context.")
}
diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml
index dd91f75986..f762869057 100644
--- a/src/witness/witnessConstraints.ml
+++ b/src/witness/witnessConstraints.ml
@@ -51,6 +51,7 @@ struct
end
(* TODO: weaken R to Lattice.S ? *)
+(* TODO: fix after traces, domaintest fails *)
module HoareMap (SpecD:Lattice.S) (R:SetDomain.S) =
struct
module SpecDGroupable =
@@ -62,12 +63,13 @@ struct
include MM
(* TODO: get rid of these value-ignoring set-mimicing hacks *)
- let cardinal (s: t): int = match s with
+ (* let cardinal (s: t): int = match s with
| `Top -> failwith "cardinal"
- | `Lifted s -> M.M.cardinal s
- let choose' (s: t) = match s with
+ | `Lifted s -> M.lift_f M.M.cardinal s *)
+ (* let choose' (s: t) = match s with
| `Top -> failwith "choose"
- | `Lifted s -> M.M.choose s
+ | `Lifted s -> M.lift_f M.M.choose s *)
+ let choose' = choose
let choose (s: t): SpecD.t = fst (choose' s)
let filter' = filter
let filter (p: key -> bool) (s: t): t = filter (fun x _ -> p x) s
@@ -77,46 +79,54 @@ struct
let for_all (p: key -> bool) (s: t): bool = for_all (fun x _ -> p x) s
let fold' = fold
let fold (f: key -> 'a -> 'a) (s: t) (acc: 'a): 'a = fold (fun x _ acc -> f x acc) s acc
- let singleton (x: key) (r: R.t): t = `Lifted (M.M.singleton x r)
- let empty (): t = `Lifted M.M.empty
- let add (x: key) (r: R.t) (s: t): t = match s with
+ (* let singleton (x: key) (r: R.t): t = `Lifted (M.lift @@ M.M.singleton x r) *)
+ (* let empty (): t = `Lifted (M.lift @@ M.M.empty) *)
+ (* let add (x: key) (r: R.t) (s: t): t = match s with
| `Top -> `Top
- | `Lifted s -> `Lifted (M.M.add x (R.join r (M.find x s)) s)
- let map (f: key -> key) (s: t): t = match s with
+ | `Lifted s -> `Lifted (M.lift_f' (M.M.add x (R.join r (M.find x s))) s) *)
+ let add (x: key) (r: R.t) (s: t): t = add x (R.join r (find x s)) s (* TODO: is this the same? *)
+ (* let map (f: key -> key) (s: t): t = match s with
| `Top -> `Top
- | `Lifted s -> `Lifted (M.fold (fun x v acc -> M.M.add (f x) (R.join v (M.find (f x) acc)) acc) s (M.M.empty))
+ | `Lifted s -> `Lifted (M.fold (fun x v acc -> M.lift_f' (M.M.add (f x) (R.join v (M.find (f x) acc))) acc) s (M.lift @@ M.M.empty)) *)
+ let map (f: key -> key) (s: t): t = fold' (fun x v acc -> add (f x) v acc) s (empty ()) (* TODO: is this the same? *)
let map' = map (* HACK: for PathSensitive morphstate *)
(* TODO: reducing map, like HoareSet *)
module S =
struct
- let exists (p: key -> bool) (s: M.t): bool = M.M.exists (fun x _ -> p x) s
- let filter (p: key -> bool) (s: M.t): M.t = M.M.filter (fun x _ -> p x) s
- let elements (s: M.t): (key * R.t) list = M.M.bindings s
- let of_list (l: (key * R.t) list): M.t = List.fold_left (fun acc (x, r) -> M.M.add x (R.join r (M.find x acc)) acc) M.M.empty l
- let union = M.long_map2 R.union
+ (* let exists (p: key -> bool) (s: M.t): bool = M.lift_f (M.M.exists (fun x _ -> p x)) s *)
+ let exists (p: key -> bool) (s: t): bool = exists (fun x _ -> p x) s
+ (* let filter (p: key -> bool) (s: M.t): M.t = M.lift_f' (M.M.filter (fun x _ -> p x)) s *)
+ let filter (p: key -> bool) (s: t): t = filter' (fun x _ -> p x) s
+ (* let elements (s: M.t): (key * R.t) list = M.lift_f M.M.bindings s *)
+ let elements (s: t): (key * R.t) list = bindings s
+ (* let of_list (l: (key * R.t) list): M.t = List.fold_left (fun acc (x, r) -> M.lift_f' (M.M.add x (R.join r (M.find x acc))) acc) (M.lift @@ M.M.empty) l *)
+ let of_list (l: (key * R.t) list): t = List.fold_left (fun acc (x, r) -> add x r acc) (empty ()) l
+ let union = long_map2 R.union
end
(* copied & modified from SetDomain.Hoare *)
- let mem x xr = function
+ (* let mem x xr = function
| `Top -> true
(* | `Lifted s -> S.exists (Spec.D.leq x) s *)
(* exists check per previous VIE.t in R.t *)
(* seems to be necessary for correct ARG but why? *)
(* | `Lifted s -> R.for_all (fun vie -> M.M.exists (fun y yr -> Spec.D.leq x y && R.mem vie yr) s) xr *)
(* | `Lifted s -> R.for_all (fun vie -> M.M.exists (fun y yr -> Spec.D.leq x y && R.exists (fun vie' -> VIE.leq vie vie') yr) s) xr *)
- | `Lifted s -> R.for_all (fun vie -> M.M.exists (fun y yr -> SpecD.leq x y && R.mem vie yr) s) xr
- let leq a b =
+ | `Lifted s -> R.for_all (fun vie -> M.lift_f (M.M.exists (fun y yr -> SpecD.leq x y && R.mem vie yr)) s) xr *)
+ let mem x xr s = R.for_all (fun vie -> exists (fun y yr -> SpecD.leq x y && R.mem vie yr) s) xr
+ (* let leq a b =
match a with
| `Top -> b = `Top
- | _ -> for_all' (fun x xr -> mem x xr b) a (* mem uses B.leq! *)
+ | _ -> for_all' (fun x xr -> mem x xr b) a (* mem uses B.leq! *) *)
+ let leq a b = for_all' (fun x xr -> mem x xr b) a (* mem uses B.leq! *)
let le x y = SpecD.leq x y && not (SpecD.equal x y) && not (SpecD.leq y x)
(* let reduce = function
| `Top -> `Top
| `Lifted s -> `Lifted (S.filter (fun x -> not (S.exists (le x) s) && not (SpecD.is_bot x)) s) *)
- let reduce: t -> t = function
+ (* let reduce: t -> t = function
| `Top -> `Top
| `Lifted s ->
(* get map with just maximal keys and their ranges *)
@@ -132,23 +142,47 @@ struct
) s xr
) maximals
in
- `Lifted maximals
- let product_bot op op2 a b = match a,b with
+ `Lifted maximals *)
+ let reduce (s: t): t =
+ (* get map with just maximal keys and their ranges *)
+ let maximals = S.filter (fun x -> not (S.exists (le x) s) && not (SpecD.is_bot x)) s in
+ (* join le ranges also *)
+ let maximals =
+ mapi (fun x xr ->
+ fold' (fun y yr acc ->
+ if le y x then
+ R.join acc yr
+ else
+ acc
+ ) s xr
+ ) maximals
+ in
+ maximals
+ (* let product_bot op op2 a b = match a,b with
| `Top, a | a, `Top -> a
| `Lifted a, `Lifted b ->
let a,b = S.elements a, S.elements b in
- List.map (fun (x,xr) -> List.map (fun (y,yr) -> (op x y, op2 xr yr)) b) a |> List.flatten |> fun x -> reduce (`Lifted (S.of_list x))
- let product_bot2 op2 a b = match a,b with
+ List.map (fun (x,xr) -> List.map (fun (y,yr) -> (op x y, op2 xr yr)) b) a |> List.flatten |> fun x -> reduce (`Lifted (S.of_list x)) *)
+ let product_bot op op2 a b =
+ let a,b = S.elements a, S.elements b in
+ List.map (fun (x,xr) -> List.map (fun (y,yr) -> (op x y, op2 xr yr)) b) a |> List.flatten |> fun x -> reduce (S.of_list x)
+ (* let product_bot2 op2 a b = match a,b with
| `Top, a | a, `Top -> a
| `Lifted a, `Lifted b ->
let a,b = S.elements a, S.elements b in
- List.map (fun (x,xr) -> List.map (fun (y,yr) -> op2 (x, xr) (y, yr)) b) a |> List.flatten |> fun x -> reduce (`Lifted (S.of_list x))
+ List.map (fun (x,xr) -> List.map (fun (y,yr) -> op2 (x, xr) (y, yr)) b) a |> List.flatten |> fun x -> reduce (`Lifted (S.of_list x)) *)
+ let product_bot2 op2 a b =
+ let a,b = S.elements a, S.elements b in
+ List.map (fun (x,xr) -> List.map (fun (y,yr) -> op2 (x, xr) (y, yr)) b) a |> List.flatten |> fun x -> reduce (S.of_list x)
(* why are type annotations needed for product_widen? *)
- let product_widen op op2 (a:t) (b:t): t = match a,b with (* assumes b to be bigger than a *)
+ (* let product_widen op op2 (a:t) (b:t): t = match a,b with (* assumes b to be bigger than a *)
| `Top, _ | _, `Top -> `Top
| `Lifted a, `Lifted b ->
let xs,ys = S.elements a, S.elements b in
- List.map (fun (x,xr) -> List.map (fun (y,yr) -> (op x y, op2 xr yr)) ys) xs |> List.flatten |> fun x -> reduce (`Lifted (S.union b (S.of_list x)))
+ List.map (fun (x,xr) -> List.map (fun (y,yr) -> (op x y, op2 xr yr)) ys) xs |> List.flatten |> fun x -> reduce (`Lifted (S.union b (S.of_list x))) *)
+ let product_widen op op2 (a:t) (b:t): t =
+ let xs,ys = S.elements a, S.elements b in
+ List.map (fun (x,xr) -> List.map (fun (y,yr) -> (op x y, op2 xr yr)) ys) xs |> List.flatten |> fun x -> reduce (S.union b (S.of_list x))
let join a b = join a b |> reduce
let meet = product_bot SpecD.meet R.inter
(* let narrow = product_bot (fun x y -> if SpecD.leq y x then SpecD.narrow x y else x) R.narrow *)
@@ -157,9 +191,10 @@ struct
let widen = product_widen (fun x y -> if SpecD.leq x y then SpecD.widen x y else SpecD.bot ()) R.widen
(* TODO: shouldn't this also reduce? *)
- let apply_list f = function
+ (* let apply_list f = function
| `Top -> `Top
- | `Lifted s -> `Lifted (S.elements s |> f |> S.of_list)
+ | `Lifted s -> `Lifted (S.elements s |> f |> S.of_list) *)
+ let apply_list f s = S.elements s |> f |> S.of_list
end
module N = struct let topname = "Top" end
@@ -264,14 +299,19 @@ struct
let widen = binop widen
let narrow = binop narrow
- let invariant c s =
+ (* let invariant c s =
match s with
| `Top -> failwith "invariant Top"
| `Lifted s ->
(* TODO: optimize indexing, using inner hashcons somehow? *)
(* let (d, _) = List.at (S.elements s) c.Invariant.i in *)
let (d, _) = List.find (fun (x, _) -> I.to_int x = c.Invariant.i) (S.elements s) in
- Spec.D.invariant c d
+ Spec.D.invariant c d *)
+ let invariant c s =
+ (* TODO: optimize indexing, using inner hashcons somehow? *)
+ (* let (d, _) = List.at (S.elements s) c.Invariant.i in *)
+ let (d, _) = List.find (fun (x, _) -> I.to_int x = c.Invariant.i) (S.elements s) in
+ Spec.D.invariant c d
end
(* Additional dependencies component between values before and after sync.
@@ -334,25 +374,9 @@ struct
try Dom.add (g (f (conv ctx x))) (step_ctx_edge ctx x) xs
with Deadcode -> xs
in
- let d = Dom.fold h (fst ctx.local) (Dom.empty ()) in
+ let d = Dom.fold h (fst ctx.local) (Dom.empty ()) |> Dom.reduce in
if Dom.is_bot d then raise Deadcode else (d, Sync.bot ())
- let assign ctx l e = map ctx Spec.assign (fun h -> h l e )
- let vdecl ctx v = map ctx Spec.vdecl (fun h -> h v)
- let body ctx f = map ctx Spec.body (fun h -> h f )
- let return ctx e f = map ctx Spec.return (fun h -> h e f )
- let branch ctx e tv = map ctx Spec.branch (fun h -> h e tv)
- let intrpt ctx = map ctx Spec.intrpt identity
- let asm ctx = map ctx Spec.asm identity
- let skip ctx = map ctx Spec.skip identity
- let special ctx l f a = map ctx Spec.special (fun h -> h l f a)
-
- (* TODO: do additional witness things here *)
- let threadenter ctx lval f args = map ctx Spec.threadenter (fun h -> h lval f args)
- let threadspawn ctx lval f args fctx =
- let fd1 = Dom.choose (fst fctx.local) in
- map ctx Spec.threadspawn (fun h -> h lval f args (conv fctx fd1))
-
let fold ctx f g h a =
let k x a =
try h a @@ g @@ f @@ conv ctx x
@@ -375,8 +399,35 @@ struct
in
Dom.fold' k (fst ctx.local) a
- let sync ctx =
- fold'' ctx Spec.sync identity (fun ((a, async),b) x r (a',b') ->
+ let assign ctx l e = map ctx Spec.assign (fun h -> h l e )
+ let vdecl ctx v = map ctx Spec.vdecl (fun h -> h v)
+ let body ctx f = map ctx Spec.body (fun h -> h f )
+ let return ctx e f = map ctx Spec.return (fun h -> h e f )
+ let branch ctx e tv = map ctx Spec.branch (fun h -> h e tv)
+ let intrpt ctx = map ctx Spec.intrpt identity
+ let asm ctx = map ctx Spec.asm identity
+ let skip ctx = map ctx Spec.skip identity
+ let special ctx l f a = map ctx Spec.special (fun h -> h l f a)
+
+ (* TODO: do additional witness things here *)
+ let threadenter ctx lval f args =
+ let g xs x' ys =
+ let ys' = List.map (fun y ->
+ (* R.bot () isn't right here? doesn't actually matter? *)
+ let yr = R.bot () in
+ (* keep left syncs so combine gets them for no-inline case *)
+ (Dom.singleton y yr, Sync.bot ())
+ ) ys
+ in
+ ys' @ xs
+ in
+ fold' ctx Spec.threadenter (fun h -> h lval f args) g []
+ let threadspawn ctx lval f args fctx =
+ let fd1 = Dom.choose (fst fctx.local) in
+ map ctx Spec.threadspawn (fun h -> h lval f args (conv fctx fd1))
+
+ let sync ctx reason =
+ fold'' ctx Spec.sync (fun h -> h reason) (fun ((a, async),b) x r (a',b') ->
(Dom.add a' r a, Sync.add a' (SyncSet.singleton x) async), b'@b
) ((Dom.empty (), Sync.bot ()), [])
diff --git a/tests/regression/01-cpa/47-earlyglobs_precious.c b/tests/regression/01-cpa/47-earlyglobs_precious.c
new file mode 100644
index 0000000000..84c084cf92
--- /dev/null
+++ b/tests/regression/01-cpa/47-earlyglobs_precious.c
@@ -0,0 +1,8 @@
+// PARAM: --set exp.earlyglobs true --set exp.precious_globs[+] "'g'"
+
+int g = 10;
+int main(void){
+ g = 100;
+ assert(g==100);
+ return 0;
+}
\ No newline at end of file
diff --git a/tests/regression/02-base/02-simple_assignments.c b/tests/regression/02-base/02-simple_assignments.c
index 15569580e2..06d8562d32 100644
--- a/tests/regression/02-base/02-simple_assignments.c
+++ b/tests/regression/02-base/02-simple_assignments.c
@@ -24,7 +24,7 @@ int main() {
glob1 = 5;
assert(glob1 == 5);
glob2 = 5;
- assert(glob2 == 5); // UNKNOWN
+ assert(glob2 == 5); // TODO
return 0;
}
diff --git a/tests/regression/02-base/06-side_effect1.c b/tests/regression/02-base/06-side_effect1.c
index 1293f5b95e..402f70034a 100644
--- a/tests/regression/02-base/06-side_effect1.c
+++ b/tests/regression/02-base/06-side_effect1.c
@@ -1,4 +1,4 @@
-// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mallocWrapper']"
+// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mutex','mallocWrapper']"
#include
#include
@@ -10,7 +10,7 @@ int glob3 = 9;
void *t_fun(void *arg) {
glob3 = 9;
- assert(glob3 == 9); // UNKNOWN
+ assert(glob3 == 9); // UNKNOWN!
return NULL;
}
@@ -24,10 +24,10 @@ int main() {
assert(glob1 == 5);
glob2 = 5;
- assert(glob2 == 5); // UNKNOWN
+ assert(glob2 == 5); // TODO
glob3 = 8;
- assert(glob3 == 8); // UNKNOWN
+ assert(glob3 == 8); // UNKNOWN!
return 0;
}
diff --git a/tests/regression/02-base/07-side_effect2.c b/tests/regression/02-base/07-side_effect2.c
index 380abc00c9..9d648dd2f9 100644
--- a/tests/regression/02-base/07-side_effect2.c
+++ b/tests/regression/02-base/07-side_effect2.c
@@ -1,4 +1,4 @@
-// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mallocWrapper']"
+// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mutex','mallocWrapper']"
#include
#include
@@ -10,7 +10,7 @@ int glob3 = 9;
void *t_fun(void *arg) {
glob3 = 8;
- assert(glob3 == 8); // UNKNOWN
+ assert(glob3 == 8); // UNKNOWN!
return NULL;
}
@@ -24,10 +24,10 @@ int main() {
assert(glob1 == 5);
glob2 = 5;
- assert(glob2 == 5); // UNKNOWN
+ assert(glob2 == 5); // TODO
glob3 = 9;
- assert(glob3 == 9); // UNKNOWN
+ assert(glob3 == 9); // UNKNOWN!
return 0;
}
diff --git a/tests/regression/02-base/09-ambigpointer.c b/tests/regression/02-base/09-ambigpointer.c
index c3dd9779ef..92912b62cc 100644
--- a/tests/regression/02-base/09-ambigpointer.c
+++ b/tests/regression/02-base/09-ambigpointer.c
@@ -1,4 +1,4 @@
-// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mallocWrapper']"
+// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mutex','mallocWrapper']"
#include
#include
diff --git a/tests/regression/02-base/10-init_allfuns.c b/tests/regression/02-base/10-init_allfuns.c
index e571cf5863..4d79d1d1df 100644
--- a/tests/regression/02-base/10-init_allfuns.c
+++ b/tests/regression/02-base/10-init_allfuns.c
@@ -1,4 +1,4 @@
-// PARAM: --enable allfuns --set ana.activated "['base','threadid','threadflag','escape','mallocWrapper']"
+// PARAM: --enable allfuns --set ana.activated "['base','threadid','threadflag','escape','mutex','mallocWrapper']"
int glob1 = 5;
int glob2 = 7;
diff --git a/tests/regression/02-base/23-malloc_globmt.c b/tests/regression/02-base/23-malloc_globmt.c
index 725709b5f0..3ce00d549c 100644
--- a/tests/regression/02-base/23-malloc_globmt.c
+++ b/tests/regression/02-base/23-malloc_globmt.c
@@ -1,4 +1,4 @@
-// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mallocWrapper']"
+// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mutex','mallocWrapper']"
#include
#include
#include
diff --git a/tests/regression/02-base/30-escape_sound.c b/tests/regression/02-base/30-escape_sound.c
index b31fdedff1..3fa6efea54 100644
--- a/tests/regression/02-base/30-escape_sound.c
+++ b/tests/regression/02-base/30-escape_sound.c
@@ -1,4 +1,4 @@
-// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mallocWrapper']"
+// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mutex','mallocWrapper']"
#include
#include
diff --git a/tests/regression/02-base/35-calloc_array.c b/tests/regression/02-base/35-calloc_array.c
index a17fb7ccca..3fb0260845 100644
--- a/tests/regression/02-base/35-calloc_array.c
+++ b/tests/regression/02-base/35-calloc_array.c
@@ -6,14 +6,14 @@
int main(void) {
int *r = calloc(5,sizeof(int));
- assert(r[0] == 0);
-
+ assert(r[0] == 0);
+
r[0] = 3;
- assert(r[0] == 3); //UNKNOWN
+ assert(r[0] == 3); //UNKNOWN
int z = r[1];
- assert(z == 0); //UNKNOWN
+ assert(z == 0); //UNKNOWN
assert(z != 365);
}
\ No newline at end of file
diff --git a/tests/regression/02-base/36-calloc_struct.c b/tests/regression/02-base/36-calloc_struct.c
index ac586577be..2711ad2115 100644
--- a/tests/regression/02-base/36-calloc_struct.c
+++ b/tests/regression/02-base/36-calloc_struct.c
@@ -23,20 +23,20 @@ int main(void) {
int a = d -> x;
int b = d -> y;
- assert(a != 3);
- assert(b != 4);
+ assert(a != 3);
+ assert(b != 4);
d -> x = 3;
d -> y = 4;
data f = {.x = 3, .y = 3};
- assert(d->x == f.x); //UNKNOWN
- assert(d->y == f.y); //UNKNOWN
+ assert(d->x == f.x); //UNKNOWN
+ assert(d->y == f.y); //UNKNOWN
a = d -> x;
b = d -> y;
- assert(a == 3); //UNKNOWN
- assert(b == 4); //UNKNOWN
+ assert(a == 3); //UNKNOWN
+ assert(b == 4); //UNKNOWN
}
\ No newline at end of file
diff --git a/tests/regression/02-base/37-calloc_glob.c b/tests/regression/02-base/37-calloc_glob.c
index c29545444f..c952fc69c8 100644
--- a/tests/regression/02-base/37-calloc_glob.c
+++ b/tests/regression/02-base/37-calloc_glob.c
@@ -1,4 +1,4 @@
-// Made after 02 22
+// Made after 02 22
// PARAM: --set ana.int.interval true --enable exp.partition-arrays.enabled
diff --git a/tests/regression/02-base/38-calloc_int.c b/tests/regression/02-base/38-calloc_int.c
index 592e01c067..e866de2985 100644
--- a/tests/regression/02-base/38-calloc_int.c
+++ b/tests/regression/02-base/38-calloc_int.c
@@ -12,7 +12,7 @@ int main(void) {
r[0] = 5;
- assert(r[0] == 5); //UNKNOWN
+ assert(r[0] == 5); //UNKNOWN
assert(r[0] != 0); //UNKNOWN
assert(r[0] != -10);
assert(r[0] != 100);
diff --git a/tests/regression/02-base/41-calloc_globmt.c b/tests/regression/02-base/41-calloc_globmt.c
index f1fbcbba1d..327ae751bd 100644
--- a/tests/regression/02-base/41-calloc_globmt.c
+++ b/tests/regression/02-base/41-calloc_globmt.c
@@ -1,4 +1,4 @@
-// PARAM: --set ana.activated "['base','threadid','threadflag','escape', 'mallocWrapper']" --set ana.int.interval true --enable exp.partition-arrays.enabled
+// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mutex', 'mallocWrapper']" --set ana.int.interval true --enable exp.partition-arrays.enabled
#include
#include
#include
diff --git a/tests/regression/02-base/42-calloc_zero_init.c b/tests/regression/02-base/42-calloc_zero_init.c
index 78b5e2191f..9505978603 100644
--- a/tests/regression/02-base/42-calloc_zero_init.c
+++ b/tests/regression/02-base/42-calloc_zero_init.c
@@ -9,5 +9,5 @@ int main(void) {
assert(ro[1] == 0);
ro[0] = 3;
- assert(ro[1] != 3); //UNKNOWN
+ assert(ro[1] != 3); //UNKNOWN
}
\ No newline at end of file
diff --git a/tests/regression/02-base/43-calloc_struct_array.c b/tests/regression/02-base/43-calloc_struct_array.c
index 3e0d976cf7..972272dd36 100644
--- a/tests/regression/02-base/43-calloc_struct_array.c
+++ b/tests/regression/02-base/43-calloc_struct_array.c
@@ -4,7 +4,7 @@
#include
struct h {
- int a[2];
+ int a[2];
int b;
};
diff --git a/tests/regression/02-base/44-malloc_array.c b/tests/regression/02-base/44-malloc_array.c
index cdfb67d06c..ec9aedf6a5 100644
--- a/tests/regression/02-base/44-malloc_array.c
+++ b/tests/regression/02-base/44-malloc_array.c
@@ -7,7 +7,7 @@ int main(void) {
r[3] = 2;
- assert(r[4] == 2);
+ assert(r[4] == 2);
/* Here we only test our implementation. Concretely, accessing the uninitialised r[4] is undefined behavior.
In our implementation we keep the whole memory allocated by malloc as one Blob and the whole Blob contains 2 after it was assigned to r[3].
This is more useful than keeping the Blob unknown. */
diff --git a/tests/regression/02-base/45-branched_thread_creation_return.c b/tests/regression/02-base/45-branched_thread_creation_return.c
new file mode 100644
index 0000000000..2c03908aa8
--- /dev/null
+++ b/tests/regression/02-base/45-branched_thread_creation_return.c
@@ -0,0 +1,35 @@
+#include
+#include
+
+void *t_fun(void *arg) {
+ return NULL;
+}
+
+int glob1 = 3;
+int glob2 = 9;
+
+int main() {
+ int k;
+ pthread_t id;
+
+ if (k)
+ pthread_create(&id, NULL, t_fun, NULL);
+ else
+ glob1 = 4;
+
+ // We need to side-effect glob1=4 upon the join here;
+ // otherwise, the global invariant will still have glob1=3.
+
+ k = glob1;
+ assert(k == 3); // UNKNOWN!
+
+ k = glob2;
+ assert(k == 9);
+
+ // This would cause glob1=4 side effect to disappear
+ // if it's side-effected only on return.
+ glob1 = 3;
+
+ return 0;
+}
+
diff --git a/tests/regression/03-practical/14-call_by_pointer.c b/tests/regression/03-practical/14-call_by_pointer.c
index ed19bebae8..f7c3f6d2a9 100644
--- a/tests/regression/03-practical/14-call_by_pointer.c
+++ b/tests/regression/03-practical/14-call_by_pointer.c
@@ -1,4 +1,4 @@
-// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mallocWrapper']"
+// PARAM: --set ana.activated "['base','threadid','threadflag','escape','mutex','mallocWrapper']"
#include
/**
diff --git a/tests/regression/03-practical/20-extern_nonpriv_sound.c b/tests/regression/03-practical/20-extern_nonpriv_sound.c
new file mode 100644
index 0000000000..b74e9ab05a
--- /dev/null
+++ b/tests/regression/03-practical/20-extern_nonpriv_sound.c
@@ -0,0 +1,19 @@
+#include
+#include
+
+int glob = 5; // not static!
+
+extern void foo(); // unknown function may screw up glob
+
+void *t_fun(void *arg) {
+ foo();
+ return NULL;
+}
+
+int main() {
+ pthread_t id;
+ assert(glob == 5);
+ pthread_create(&id, NULL, t_fun, NULL);
+ assert(glob == 5); // UNKNOWN!
+ return 0;
+}
diff --git a/tests/regression/03-practical/21-pfscan_combine_minimal.c b/tests/regression/03-practical/21-pfscan_combine_minimal.c
new file mode 100644
index 0000000000..5054260216
--- /dev/null
+++ b/tests/regression/03-practical/21-pfscan_combine_minimal.c
@@ -0,0 +1,58 @@
+#include
+
+struct __anonstruct_PQUEUE_63 {
+ int closed ;
+ pthread_mutex_t mtx ;
+};
+typedef struct __anonstruct_PQUEUE_63 PQUEUE;
+
+PQUEUE pqb;
+
+int pqueue_init(PQUEUE *qp)
+{
+ qp->closed = 0;
+ pthread_mutex_init(& qp->mtx, NULL);
+ return (0);
+}
+
+void pqueue_close(PQUEUE *qp )
+{
+ pthread_mutex_lock(& qp->mtx);
+ qp->closed = 1;
+ pthread_mutex_unlock(& qp->mtx);
+ return;
+}
+
+int pqueue_put(PQUEUE *qp)
+{
+ pthread_mutex_lock(& qp->mtx);
+ if (qp->closed) {
+ // pfscan actually has a bug and is missing the following unlock at early return
+ // pthread_mutex_unlock(& qp->mtx);
+
+ return (0);
+ }
+ pthread_mutex_unlock(& qp->mtx);
+ return (1);
+}
+
+void *worker(void *arg )
+{
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+
+ PQUEUE *qp = &pqb;
+ pqueue_init(& pqb);
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ for (int i = 1; i < argc; i++) {
+ pqueue_put(& pqb);
+ }
+
+ pqueue_close(& pqb);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/18-first-reads.c b/tests/regression/13-privatized/18-first-reads.c
new file mode 100644
index 0000000000..1732f406a7
--- /dev/null
+++ b/tests/regression/13-privatized/18-first-reads.c
@@ -0,0 +1,35 @@
+// PARAM: --set ana.int.interval true --set solver "'td3'"
+#include
+#include
+
+int glob1 = 0;
+pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ int t;
+ pthread_mutex_lock(&mutex1);
+ if(t == 42) {
+ glob1 = 1;
+ }
+ t = glob1;
+
+ assert(t == 0); //UNKNOWN!
+
+ assert(t == 1); //UNKNOWN!
+
+ glob1 = 0;
+
+ pthread_mutex_unlock(&mutex1);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(glob1 == 0);
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_mutex_lock(&mutex1);
+ assert(glob1 == 0);
+ pthread_mutex_unlock(&mutex1);
+ pthread_join (id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/19-publish-precision.c b/tests/regression/13-privatized/19-publish-precision.c
new file mode 100644
index 0000000000..2a87589a95
--- /dev/null
+++ b/tests/regression/13-privatized/19-publish-precision.c
@@ -0,0 +1,36 @@
+// PARAM: --set ana.int.interval true --set solver "'td3'"
+#include
+#include
+
+int glob1 = 0;
+pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ int t;
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&mutex2);
+ glob1 = 5;
+
+ pthread_mutex_unlock(&mutex2);
+ pthread_mutex_lock(&mutex2);
+
+ assert(glob1 == 5);
+ glob1 = 0;
+
+ pthread_mutex_unlock(&mutex2);
+ pthread_mutex_unlock(&mutex1);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(glob1 == 0);
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_mutex_lock(&mutex2);
+ assert(glob1 == 0); // UNKNOWN!
+ assert(glob1 == 5); // UNKNOWN!
+ pthread_mutex_unlock(&mutex2);
+ pthread_join (id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/20-publish-regression.c b/tests/regression/13-privatized/20-publish-regression.c
new file mode 100644
index 0000000000..724506c3d1
--- /dev/null
+++ b/tests/regression/13-privatized/20-publish-regression.c
@@ -0,0 +1,37 @@
+// PARAM: --set ana.int.interval true --set solver "'td3'"
+
+#include
+#include
+
+int glob1 = 0;
+pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER;
+
+// The question is how to compute these S[g] sets?
+// They are given in the paper. Should it be as large as possible?
+
+void *t_fun(void *arg) {
+ int t;
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&mutex2);
+ glob1 = 5;
+ pthread_mutex_unlock(&mutex2);
+ // But if s[g] = {mutex1,mutex2}, we publish here.
+ pthread_mutex_lock(&mutex2);
+ assert(glob1 == 5);
+ glob1 = 0;
+ pthread_mutex_unlock(&mutex1);
+ pthread_mutex_unlock(&mutex2);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(glob1 == 0);
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_mutex_lock(&mutex1);
+ assert(glob1 == 0);
+ pthread_mutex_unlock(&mutex1);
+ pthread_join (id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/21-publish-basic.c b/tests/regression/13-privatized/21-publish-basic.c
new file mode 100644
index 0000000000..3542e2d468
--- /dev/null
+++ b/tests/regression/13-privatized/21-publish-basic.c
@@ -0,0 +1,25 @@
+// PARAM: --set ana.int.interval true --set solver "'td3'"
+#include
+#include
+
+int glob1 = 0;
+pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ int t;
+ pthread_mutex_lock(&mutex);
+ glob1 = 5;
+ assert(glob1 == 5);
+ pthread_mutex_unlock(&mutex);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(glob1 == 0);
+ pthread_create(&id, NULL, t_fun, NULL);
+ assert(glob1 == 0); // UNKNOWN!
+ assert(glob1 == 5); // UNKNOWN!
+ pthread_join (id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/22-traces-paper.c b/tests/regression/13-privatized/22-traces-paper.c
new file mode 100644
index 0000000000..c07617b61a
--- /dev/null
+++ b/tests/regression/13-privatized/22-traces-paper.c
@@ -0,0 +1,40 @@
+// PARAM: --enable ana.int.interval --sets exp.solver.td3.side_widen cycle_self
+#include
+#include
+
+int g = 6;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ int x = 1;
+ pthread_mutex_lock(&A);
+ assert(g == 6);
+ assert(x == 1);
+ g = 5;
+ assert(g == 5);
+ assert(x == 1);
+ pthread_mutex_lock(&B);
+ assert(g == 5);
+ assert(x == 1);
+ pthread_mutex_unlock(&B);
+ assert(g == 5);
+ assert(x == 1);
+ x = g;
+ assert(x == 5);
+ g = x + 1;
+ assert(g == 6);
+ pthread_mutex_unlock(&A);
+ assert(x == 5);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(g == 6);
+ pthread_create(&id, NULL, t_fun, NULL);
+ assert(5 <= g);
+ assert(g <= 6);
+ pthread_join(id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/23-traces-paper2.c b/tests/regression/13-privatized/23-traces-paper2.c
new file mode 100644
index 0000000000..d338f1debb
--- /dev/null
+++ b/tests/regression/13-privatized/23-traces-paper2.c
@@ -0,0 +1,43 @@
+// PARAM: --enable ana.int.interval --sets exp.solver.td3.side_widen cycle_self
+#include
+#include
+
+int g = 6;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ int x = 1;
+ pthread_mutex_lock(&A);
+ assert(g == 6);
+ assert(x == 1);
+ g = 5;
+ assert(g == 5);
+ assert(x == 1);
+ pthread_mutex_lock(&B);
+ assert(g == 5);
+ assert(x == 1);
+ pthread_mutex_unlock(&B);
+ assert(g == 5);
+ assert(x == 1);
+ x = g;
+ assert(x == 5);
+ g = x + 1;
+ assert(g == 6);
+ x = g; // added
+ assert(g == 6); // added
+ assert(x == 6); // added
+ pthread_mutex_unlock(&A);
+ assert(x == 6); // modified
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(g == 6);
+ pthread_create(&id, NULL, t_fun, NULL);
+ assert(5 <= g);
+ assert(g <= 6);
+ pthread_join(id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/24-multiple-protecting.c b/tests/regression/13-privatized/24-multiple-protecting.c
new file mode 100644
index 0000000000..c177b3e6f2
--- /dev/null
+++ b/tests/regression/13-privatized/24-multiple-protecting.c
@@ -0,0 +1,56 @@
+// Copied & modified from 28/42.
+#include
+#include
+
+int g1,g2;
+pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t __global_lock = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&__global_lock);
+ g1++;
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_lock(&__global_lock);
+ g1--;
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex1);
+
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ g2++;
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_lock(&__global_lock);
+ g2--;
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex2);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&__global_lock);
+ assert(g1 == 0);
+ pthread_mutex_unlock(&__global_lock);
+
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ assert(g1 == 0);
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_lock(&__global_lock);
+ assert(g2 == 0);
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex2);
+
+ pthread_mutex_lock(&__global_lock);
+ assert(g1 == 0);
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex1);
+
+ pthread_join(id, NULL);
+ return 0;
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/25-struct_nr.c b/tests/regression/13-privatized/25-struct_nr.c
new file mode 100644
index 0000000000..fbb2756ff9
--- /dev/null
+++ b/tests/regression/13-privatized/25-struct_nr.c
@@ -0,0 +1,35 @@
+#include
+#include
+
+struct lock {
+ pthread_mutex_t mutex;
+};
+
+int glob1 = 5;
+struct lock lock1 = {.mutex = PTHREAD_MUTEX_INITIALIZER};
+// struct lock lock2 = {.mutex = PTHREAD_MUTEX_INITIALIZER};
+
+void *t_fun(void *arg) {
+ int t;
+ pthread_mutex_lock(&lock1.mutex);
+ t = glob1;
+ assert(t == 5);
+ glob1 = -10;
+ assert(glob1 == -10);
+ glob1 = t;
+ pthread_mutex_unlock(&lock1.mutex);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(glob1 == 5);
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_mutex_lock(&lock1.mutex);
+ glob1++;
+ assert(glob1 == 6);
+ glob1--;
+ pthread_mutex_unlock(&lock1.mutex);
+ pthread_join (id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/26-struct_rc.c b/tests/regression/13-privatized/26-struct_rc.c
new file mode 100644
index 0000000000..442fe1ee86
--- /dev/null
+++ b/tests/regression/13-privatized/26-struct_rc.c
@@ -0,0 +1,35 @@
+#include
+#include
+
+struct lock {
+ pthread_mutex_t mutex;
+};
+
+int glob1 = 5;
+struct lock lock1 = {.mutex = PTHREAD_MUTEX_INITIALIZER};
+struct lock lock2 = {.mutex = PTHREAD_MUTEX_INITIALIZER};
+
+void *t_fun(void *arg) {
+ int t;
+ pthread_mutex_lock(&lock1.mutex);
+ t = glob1;
+ assert(t == 5); // UNKNOWN
+ glob1 = -10;
+ assert(glob1 == -10); // UNKNOWN
+ glob1 = t;
+ pthread_mutex_unlock(&lock1.mutex);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(glob1 == 5);
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_mutex_lock(&lock2.mutex);
+ glob1++;
+ assert(glob1 == 6); // UNKNOWN
+ glob1--;
+ pthread_mutex_unlock(&lock2.mutex);
+ pthread_join (id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/27-multiple-protecting2.c b/tests/regression/13-privatized/27-multiple-protecting2.c
new file mode 100644
index 0000000000..f9799a6e4f
--- /dev/null
+++ b/tests/regression/13-privatized/27-multiple-protecting2.c
@@ -0,0 +1,62 @@
+// Copied & modified from 13/24.
+#include
+#include
+
+int g1,g2;
+pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t __global_lock = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&__global_lock);
+ g1++;
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_lock(&__global_lock);
+ g1--;
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex1);
+ return NULL;
+}
+
+void *t2_fun(void *arg) {
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ g2++;
+ pthread_mutex_unlock(&__global_lock); // Write Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> 1
+ pthread_mutex_lock(&__global_lock);
+ g2--;
+ pthread_mutex_unlock(&__global_lock); // Write Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> 0
+ pthread_mutex_unlock(&mutex2);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_t id2;
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_create(&id2, NULL, t2_fun, NULL);
+
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&__global_lock); // Read & join to g2 Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> (0 join 1 = Unknown)
+ assert(g1 == 0);
+ pthread_mutex_unlock(&__global_lock);
+
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ assert(g1 == 0);
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_lock(&__global_lock);
+ assert(g2 == 0);
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex2);
+
+ pthread_mutex_lock(&__global_lock);
+ assert(g1 == 0);
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex1);
+
+ pthread_join(id, NULL);
+ pthread_join(id2, NULL);
+ return 0;
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/28-multiple-protecting2-simple.c b/tests/regression/13-privatized/28-multiple-protecting2-simple.c
new file mode 100644
index 0000000000..a22b371d56
--- /dev/null
+++ b/tests/regression/13-privatized/28-multiple-protecting2-simple.c
@@ -0,0 +1,41 @@
+// Copied & modified from 13/24.
+#include
+#include
+
+int g1,g2;
+pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t __global_lock = PTHREAD_MUTEX_INITIALIZER;
+
+void *t2_fun(void *arg) {
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ g2++;
+ pthread_mutex_unlock(&__global_lock); // Write Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> 1
+ pthread_mutex_lock(&__global_lock);
+ g2--;
+ pthread_mutex_unlock(&__global_lock); // Write Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> 0
+ pthread_mutex_unlock(&mutex2);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id2;
+ pthread_create(&id2, NULL, t2_fun, NULL);
+
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&__global_lock); // Read & join to g2 Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> (0 join 1 = Unknown)
+ assert(g1 == 0);
+ pthread_mutex_unlock(&__global_lock);
+
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ assert(g2 == 0);
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex2);
+
+ pthread_mutex_unlock(&mutex1);
+
+ pthread_join(id2, NULL);
+ return 0;
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/29-multiple-protecting2-vesal.c b/tests/regression/13-privatized/29-multiple-protecting2-vesal.c
new file mode 100644
index 0000000000..a947c94f78
--- /dev/null
+++ b/tests/regression/13-privatized/29-multiple-protecting2-vesal.c
@@ -0,0 +1,43 @@
+// PARAM: --enable ana.int.interval
+// Copied & modified from 13/24.
+#include
+#include
+
+int g2;
+pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t __global_lock = PTHREAD_MUTEX_INITIALIZER;
+
+void *t2_fun(void *arg) {
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ g2++;
+ pthread_mutex_unlock(&__global_lock); // Write Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> 1
+ pthread_mutex_lock(&__global_lock);
+ g2--;
+ pthread_mutex_unlock(&__global_lock); // Write Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> 0
+ pthread_mutex_unlock(&mutex2);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id2;
+ pthread_create(&id2, NULL, t2_fun, NULL);
+
+ pthread_mutex_lock(&mutex1);
+ pthread_mutex_lock(&__global_lock); // Read & join to g2 Mine influence: [[g2, __global_lock], t2_fun, {mutex2}] -> (0 join 1 = Unknown)
+ assert(0 <= g2); // TODO (widening)
+ assert(g2 <= 1); // TODO
+ pthread_mutex_unlock(&__global_lock);
+
+ pthread_mutex_lock(&mutex2);
+ pthread_mutex_lock(&__global_lock);
+ assert(g2 == 0); // TODO
+ pthread_mutex_unlock(&__global_lock);
+ pthread_mutex_unlock(&mutex2);
+
+ pthread_mutex_unlock(&mutex1);
+
+ pthread_join(id2, NULL);
+ return 0;
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/30-traces-oplus-vs-meet.c b/tests/regression/13-privatized/30-traces-oplus-vs-meet.c
new file mode 100644
index 0000000000..7b57ba7c99
--- /dev/null
+++ b/tests/regression/13-privatized/30-traces-oplus-vs-meet.c
@@ -0,0 +1,40 @@
+#include
+#include
+
+/*
+int g=0;
+t1: lock(A); lock(B); g = 5; unlock(B); lock(B); g = 0; unlock(A);
+t2: lock(B); lock(A); x = g; unlock(A); unlock(B); // Will read {5,0} with oplus, {0} with meet
+t3: lock(A); lock(B); x = g; unlock(B); unlock(A); // Will always read only {0}
+*/
+
+int g = 0;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ // t1
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ g = 5;
+ pthread_mutex_unlock(&B);
+ pthread_mutex_lock(&B);
+ g = 0;
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ assert(g == 0);
+ pthread_create(&id, NULL, t_fun, NULL);
+ // t2
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&A);
+ assert(g == 0);
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ pthread_join(id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/31-traces-mine-vs-mutex.c b/tests/regression/13-privatized/31-traces-mine-vs-mutex.c
new file mode 100644
index 0000000000..94576830d5
--- /dev/null
+++ b/tests/regression/13-privatized/31-traces-mine-vs-mutex.c
@@ -0,0 +1,36 @@
+// Copied & modified from 13/28.
+#include
+#include
+
+int g;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ g++;
+ pthread_mutex_unlock(&B); // Write Mine influence: [[g, B], t2_fun, {A}] -> 1
+ pthread_mutex_lock(&B);
+ g--;
+ pthread_mutex_unlock(&B); // Write Mine influence: [[g, B], t2_fun, {A}] -> 0
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&B); // Read & join to g Mine influence: [[g, B], t2_fun, {A}] -> (0 join 1 = Unknown)
+ pthread_mutex_unlock(&B);
+
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ assert(g == 0);
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&A);
+
+ pthread_join(id, NULL);
+ return 0;
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/32-traces-mine-vs-oplus-vs-meet.c b/tests/regression/13-privatized/32-traces-mine-vs-oplus-vs-meet.c
new file mode 100644
index 0000000000..f41065b7b9
--- /dev/null
+++ b/tests/regression/13-privatized/32-traces-mine-vs-oplus-vs-meet.c
@@ -0,0 +1,42 @@
+#include
+#include
+
+int g = 0;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t C = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&C);
+ pthread_mutex_lock(&B);
+ g = 5;
+ pthread_mutex_unlock(&B);
+ pthread_mutex_lock(&B);
+ g = 0;
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&C);
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ // This must be before the other to get Mine to fail for the other even with thread ID partitioning.
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&C);
+ assert(g == 0); // TODO (mine and mutex-oplus fail, mutex-meet succeeds)
+ pthread_mutex_unlock(&C);
+ pthread_mutex_unlock(&B);
+
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ assert(g == 0); // TODO (mine fails, mutex-oplus and mutex-meet succeed)
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&A);
+
+ pthread_join(id, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/33-traces-v-matters.c b/tests/regression/13-privatized/33-traces-v-matters.c
new file mode 100644
index 0000000000..8e5deabbb3
--- /dev/null
+++ b/tests/regression/13-privatized/33-traces-v-matters.c
@@ -0,0 +1,31 @@
+#include
+#include
+
+int g = 0; // doesn't matter, gets always overwritten
+pthread_mutex_t C = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t D = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t E = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&C);
+ pthread_mutex_lock(&E);
+ g = 42;
+ pthread_mutex_lock(&D);
+ pthread_mutex_unlock(&E);
+ pthread_mutex_unlock(&C);
+ pthread_mutex_unlock(&D);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&C);
+ pthread_mutex_lock(&D);
+ g = 2;
+ pthread_mutex_unlock(&C);
+ pthread_mutex_lock(&E);
+ assert(g == 2); // TODO
+ return 0;
+}
diff --git a/tests/regression/13-privatized/34-traces-minepp-L-needs-to-be-um.c b/tests/regression/13-privatized/34-traces-minepp-L-needs-to-be-um.c
new file mode 100644
index 0000000000..71f16ed684
--- /dev/null
+++ b/tests/regression/13-privatized/34-traces-minepp-L-needs-to-be-um.c
@@ -0,0 +1,41 @@
+#include
+#include
+
+int g = 42; // matches expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t C = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&C);
+ g = 15;
+ pthread_mutex_unlock(&C);
+ pthread_mutex_lock(&C);
+ g = 42;
+ pthread_mutex_unlock(&C);
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ int r;
+ if (r) {
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&C);
+ pthread_mutex_unlock(&A);
+ }
+ else {
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&C);
+ pthread_mutex_unlock(&B);
+ }
+ // mine-w also reads 15 here by weak influence, so useless example
+ assert(g == 42); // TODO
+ return 0;
+}
diff --git a/tests/regression/13-privatized/35-traces-ex-2.c b/tests/regression/13-privatized/35-traces-ex-2.c
new file mode 100644
index 0000000000..09e0aea077
--- /dev/null
+++ b/tests/regression/13-privatized/35-traces-ex-2.c
@@ -0,0 +1,30 @@
+#include
+#include
+
+int g = 0; // matches expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ g = 1;
+ pthread_mutex_unlock(&B);
+ pthread_mutex_lock(&B);
+ g = 0;
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&A);
+ assert(g == 0);
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/36-traces-ex-3.c b/tests/regression/13-privatized/36-traces-ex-3.c
new file mode 100644
index 0000000000..a76ccc18bd
--- /dev/null
+++ b/tests/regression/13-privatized/36-traces-ex-3.c
@@ -0,0 +1,28 @@
+#include
+#include
+
+int g = 2; // matches expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&B);
+ g = 1;
+ pthread_mutex_lock(&A);
+ pthread_mutex_unlock(&A);
+ g = 2;
+ pthread_mutex_unlock(&B);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ pthread_mutex_unlock(&A);
+ pthread_mutex_lock(&B);
+ assert(g == 2);
+ pthread_mutex_unlock(&B);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/37-traces-ex-4.c b/tests/regression/13-privatized/37-traces-ex-4.c
new file mode 100644
index 0000000000..183c84ab87
--- /dev/null
+++ b/tests/regression/13-privatized/37-traces-ex-4.c
@@ -0,0 +1,30 @@
+#include
+#include
+
+int g = 2; // matches expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_unlock(&A);
+ pthread_mutex_lock(&A);
+ g = 2;
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&A);
+ assert(g == 2);
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/38-traces-ex-4-switch.c b/tests/regression/13-privatized/38-traces-ex-4-switch.c
new file mode 100644
index 0000000000..e9f8225e27
--- /dev/null
+++ b/tests/regression/13-privatized/38-traces-ex-4-switch.c
@@ -0,0 +1,30 @@
+#include
+#include
+
+int g = 2; // matches expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_unlock(&A);
+ pthread_mutex_lock(&A);
+ g = 2;
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ assert(g == 2);
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/39-traces-ex-5.c b/tests/regression/13-privatized/39-traces-ex-5.c
new file mode 100644
index 0000000000..1604a98b04
--- /dev/null
+++ b/tests/regression/13-privatized/39-traces-ex-5.c
@@ -0,0 +1,33 @@
+#include
+#include
+
+int g = 2; // matches expected synchronized read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t D = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&D);
+ g = 1;
+ pthread_mutex_unlock(&D);
+ return NULL;
+}
+
+void *t2_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ g = 2;
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id, id2;
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_create(&id2, NULL, t2_fun, NULL);
+
+ pthread_mutex_lock(&D);
+ pthread_mutex_lock(&A);
+ pthread_mutex_unlock(&D);
+ assert(g == 2); // UNKNOWN!
+ pthread_mutex_unlock(&A);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/40-traces-ex-6.c b/tests/regression/13-privatized/40-traces-ex-6.c
new file mode 100644
index 0000000000..dd097f0651
--- /dev/null
+++ b/tests/regression/13-privatized/40-traces-ex-6.c
@@ -0,0 +1,27 @@
+#include
+#include
+
+int g = 2; // matches expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t D = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&D);
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_unlock(&A);
+ g = 2;
+ pthread_mutex_unlock(&D);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&D);
+ pthread_mutex_lock(&A);
+ pthread_mutex_unlock(&D);
+ assert(g == 2); // TODO
+ return 0;
+}
diff --git a/tests/regression/13-privatized/41-traces-ex-7.c b/tests/regression/13-privatized/41-traces-ex-7.c
new file mode 100644
index 0000000000..ffcdd68086
--- /dev/null
+++ b/tests/regression/13-privatized/41-traces-ex-7.c
@@ -0,0 +1,26 @@
+#include
+#include
+
+int g = 0; // matches unsound read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t D = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&D);
+ pthread_mutex_lock(&A);
+ g = 17;
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&D);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&D);
+ pthread_mutex_lock(&A);
+ pthread_mutex_unlock(&D);
+ assert(g == 0); // UNKNOWN!
+ return 0;
+}
diff --git a/tests/regression/13-privatized/42-traces-ex-mini.c b/tests/regression/13-privatized/42-traces-ex-mini.c
new file mode 100644
index 0000000000..884b76a047
--- /dev/null
+++ b/tests/regression/13-privatized/42-traces-ex-mini.c
@@ -0,0 +1,31 @@
+#include
+#include
+
+int g = 17; // matches expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t C = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&C);
+ g = 42;
+ pthread_mutex_unlock(&B);
+ g = 17;
+ pthread_mutex_unlock(&C);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&C);
+ assert(g == 17);
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&C);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/43-traces-mine1.c b/tests/regression/13-privatized/43-traces-mine1.c
new file mode 100644
index 0000000000..50386a72b3
--- /dev/null
+++ b/tests/regression/13-privatized/43-traces-mine1.c
@@ -0,0 +1,30 @@
+// PARAM: --enable ana.int.interval
+#include
+#include
+
+int g = 3; // matches one expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_lock(&B);
+ g = 2;
+ pthread_mutex_unlock(&A);
+ g = 3;
+ pthread_mutex_unlock(&B);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ assert(g >= 2); // TODO
+ pthread_mutex_lock(&B);
+ assert(g >= 2); // TODO
+ assert(g == 3); // TODO
+ return 0;
+}
diff --git a/tests/regression/13-privatized/44-traces-mine2.c b/tests/regression/13-privatized/44-traces-mine2.c
new file mode 100644
index 0000000000..107c21f7af
--- /dev/null
+++ b/tests/regression/13-privatized/44-traces-mine2.c
@@ -0,0 +1,28 @@
+#include
+#include
+
+int g = 3; // matches one expected precise read
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_lock(&B);
+ g = 2;
+ pthread_mutex_unlock(&B);
+ g = 3;
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ assert(g == 3);
+ pthread_mutex_lock(&B);
+ assert(g == 3);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/45-traces-per-global-and-current-lock-mine-incomparable.c b/tests/regression/13-privatized/45-traces-per-global-and-current-lock-mine-incomparable.c
new file mode 100644
index 0000000000..1a697fe0ac
--- /dev/null
+++ b/tests/regression/13-privatized/45-traces-per-global-and-current-lock-mine-incomparable.c
@@ -0,0 +1,30 @@
+#include
+#include
+
+int g = 0; // doesn't matter, gets always overwritten
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&B);
+ pthread_mutex_lock(&A);
+ g = 17;
+ pthread_mutex_unlock(&A);
+ pthread_mutex_unlock(&B);
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ pthread_mutex_lock(&B);
+ g = 42;
+ pthread_mutex_unlock(&B);
+ pthread_mutex_lock(&B);
+ assert(g == 42);
+ pthread_mutex_unlock(&B);
+ pthread_mutex_unlock(&A);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/46-refine-protected1.c b/tests/regression/13-privatized/46-refine-protected1.c
new file mode 100644
index 0000000000..2bd2b4d577
--- /dev/null
+++ b/tests/regression/13-privatized/46-refine-protected1.c
@@ -0,0 +1,28 @@
+#include
+#include
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ // just for going to multithreaded mode
+ return NULL;
+}
+
+int main() {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ if (g) // protected globals should be refined
+ assert(g);
+ else
+ assert(!g);
+ pthread_mutex_unlock(&A);
+
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_unlock(&A);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/47-refine-protected2.c b/tests/regression/13-privatized/47-refine-protected2.c
new file mode 100644
index 0000000000..74b8132261
--- /dev/null
+++ b/tests/regression/13-privatized/47-refine-protected2.c
@@ -0,0 +1,26 @@
+#include
+#include
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main() {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ pthread_mutex_lock(&A);
+ if (g) // protected globals should be refined
+ assert(g);
+ else
+ assert(!g);
+ pthread_mutex_unlock(&A);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/48-pfscan_protected_loop_minimal.c b/tests/regression/13-privatized/48-pfscan_protected_loop_minimal.c
new file mode 100644
index 0000000000..4c30db2144
--- /dev/null
+++ b/tests/regression/13-privatized/48-pfscan_protected_loop_minimal.c
@@ -0,0 +1,67 @@
+#include
+#include
+
+struct __anonstruct_PQUEUE_63 {
+ int occupied ;
+ pthread_mutex_t mtx ;
+};
+typedef struct __anonstruct_PQUEUE_63 PQUEUE;
+
+PQUEUE pqb ;
+
+int pqueue_init(PQUEUE *qp)
+{
+ qp->occupied = 0;
+ pthread_mutex_init(& qp->mtx, NULL);
+ return (0);
+}
+
+int pqueue_put(PQUEUE *qp)
+{
+ pthread_mutex_lock(& qp->mtx);
+ (qp->occupied) ++;
+ pthread_mutex_unlock(& qp->mtx);
+ return (1);
+}
+
+int pqueue_get(PQUEUE *qp)
+{
+ int got = 0;
+ pthread_mutex_lock(& qp->mtx);
+ while (qp->occupied <= 0) {
+ // qp->occupied should not be just 0, unsoundness in old
+ assert(qp->occupied == 0); // UNKNOWN!
+ }
+ // qp->occupied should not be Error int, unsoundness in global
+ assert(qp->occupied != 0);
+ if (qp->occupied > 0) {
+ (qp->occupied) --;
+ got = 1;
+ pthread_mutex_unlock(& qp->mtx);
+ } else {
+ pthread_mutex_unlock(& qp->mtx);
+ }
+ return (got);
+}
+
+void *worker(void *arg )
+{
+ while (1) {
+ pqueue_get(& pqb);
+ }
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+
+ PQUEUE *qp = &pqb;
+ pqueue_init(& pqb);
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ for (int i = 1; i < argc; i++) {
+ pqueue_put(& pqb);
+ }
+ return 0;
+}
diff --git a/tests/regression/13-privatized/49-refine-protected-loop.c b/tests/regression/13-privatized/49-refine-protected-loop.c
new file mode 100644
index 0000000000..5935c29d33
--- /dev/null
+++ b/tests/regression/13-privatized/49-refine-protected-loop.c
@@ -0,0 +1,62 @@
+#include
+#include
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+int pqueue_init()
+{
+ g = 0;
+ pthread_mutex_init(&A, NULL);
+ return (0);
+}
+
+int pqueue_put()
+{
+ pthread_mutex_lock(&A);
+ g++;
+ pthread_mutex_unlock(&A);
+ return (1);
+}
+
+int pqueue_get()
+{
+ int got = 0;
+ pthread_mutex_lock(&A);
+ while (g <= 0) {
+ // g should not be just 0, unsoundness in old
+ assert(g == 0); // UNKNOWN!
+ }
+ // g should not be Error int, unsoundness in global
+ assert(g != 0);
+ if (g > 0) {
+ g--;
+ got = 1;
+ pthread_mutex_unlock(&A);
+ } else {
+ pthread_mutex_unlock(&A);
+ }
+ return (got);
+}
+
+void *worker(void *arg )
+{
+ while (1) {
+ pqueue_get();
+ }
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+
+ pqueue_init();
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ for (int i = 1; i < argc; i++) {
+ pqueue_put();
+ }
+ return 0;
+}
diff --git a/tests/regression/13-privatized/50-pfscan_protected_loop_minimal2.c b/tests/regression/13-privatized/50-pfscan_protected_loop_minimal2.c
new file mode 100644
index 0000000000..4407a7dd17
--- /dev/null
+++ b/tests/regression/13-privatized/50-pfscan_protected_loop_minimal2.c
@@ -0,0 +1,73 @@
+#include
+#include
+
+struct __anonstruct_PQUEUE_63 {
+ int occupied ;
+ pthread_mutex_t mtx ;
+};
+typedef struct __anonstruct_PQUEUE_63 PQUEUE;
+
+PQUEUE pqb ;
+
+int pqueue_init(PQUEUE *qp)
+{
+ qp->occupied = 0;
+ pthread_mutex_init(& qp->mtx, NULL);
+ return (0);
+}
+
+int pqueue_put(PQUEUE *qp)
+{
+ pthread_mutex_lock(& qp->mtx);
+ (qp->occupied) ++;
+ pthread_mutex_unlock(& qp->mtx);
+ return (1);
+}
+
+int pqueue_get(PQUEUE *qp)
+{
+ int got = 0;
+ pthread_mutex_lock(& qp->mtx);
+ while (qp->occupied <= 0) {
+ // qp->occupied should not be just 0, unsoundness in old
+ assert(qp->occupied == 0); // UNKNOWN!
+ }
+ // qp->occupied should not be Error int, unsoundness in global
+ assert(qp->occupied != 0);
+ if (qp->occupied > 0) {
+ (qp->occupied) --;
+ got = 1;
+ pthread_mutex_unlock(& qp->mtx);
+ } else {
+ pthread_mutex_unlock(& qp->mtx);
+ }
+ return (got);
+}
+
+
+pthread_mutex_t print_lock = PTHREAD_MUTEX_INITIALIZER;
+
+void *worker(void *arg )
+{
+ while (1) {
+ pqueue_get(& pqb);
+ // extra mutex makes mine-W more precise than lock
+ pthread_mutex_lock(& print_lock);
+ pthread_mutex_unlock(& print_lock);
+ }
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+
+ PQUEUE *qp = &pqb;
+ pqueue_init(& pqb);
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ for (int i = 1; i < argc; i++) {
+ pqueue_put(& pqb);
+ }
+ return 0;
+}
diff --git a/tests/regression/13-privatized/51-refine-protected-loop2.c b/tests/regression/13-privatized/51-refine-protected-loop2.c
new file mode 100644
index 0000000000..7b6d211dc7
--- /dev/null
+++ b/tests/regression/13-privatized/51-refine-protected-loop2.c
@@ -0,0 +1,66 @@
+#include
+#include
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+int pqueue_init()
+{
+ g = 0;
+ pthread_mutex_init(&A, NULL);
+ return (0);
+}
+
+int pqueue_put()
+{
+ pthread_mutex_lock(&A);
+ g++;
+ pthread_mutex_unlock(&A);
+ return (1);
+}
+
+int pqueue_get()
+{
+ int got = 0;
+ pthread_mutex_lock(&A);
+ while (g <= 0) {
+ // g should not be just 0, unsoundness in old
+ assert(g == 0); // UNKNOWN!
+ }
+ // g should not be Error int, unsoundness in global
+ assert(g != 0);
+ if (g > 0) {
+ g--;
+ got = 1;
+ pthread_mutex_unlock(&A);
+ } else {
+ pthread_mutex_unlock(&A);
+ }
+ return (got);
+}
+
+void *worker(void *arg )
+{
+ while (1) {
+ pqueue_get();
+ // extra mutex makes mine-W more precise than lock
+ pthread_mutex_lock(&B);
+ pthread_mutex_unlock(&B);
+ }
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+
+ pqueue_init();
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ for (int i = 1; i < argc; i++) {
+ pqueue_put();
+ }
+ return 0;
+}
diff --git a/tests/regression/13-privatized/52-refine-protected-loop2-small.c b/tests/regression/13-privatized/52-refine-protected-loop2-small.c
new file mode 100644
index 0000000000..43fd77ebff
--- /dev/null
+++ b/tests/regression/13-privatized/52-refine-protected-loop2-small.c
@@ -0,0 +1,31 @@
+#include
+#include
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER;
+
+void *worker(void *arg )
+{
+ while (1) {
+ pthread_mutex_lock(&A);
+ g = 1000;
+ assert(g != 0);
+ if (g > 0) {
+ g--;
+ }
+ pthread_mutex_unlock(&A);
+ // extra mutex makes mine-W more precise than lock
+ pthread_mutex_lock(&B);
+ pthread_mutex_unlock(&B);
+ }
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+ pthread_create(& tid, NULL, & worker, NULL);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/53-pfscan_widen_dependent_minimal.c b/tests/regression/13-privatized/53-pfscan_widen_dependent_minimal.c
new file mode 100644
index 0000000000..6f118fb0d5
--- /dev/null
+++ b/tests/regression/13-privatized/53-pfscan_widen_dependent_minimal.c
@@ -0,0 +1,78 @@
+// PARAM: --enable ana.int.interval --enable exp.priv-distr-init
+#include
+#include
+
+// protection priv succeeds
+// write fails due to [1,1] widen [0,1] -> [-inf,1]
+// sensitive to eval and widen order!
+
+struct __anonstruct_PQUEUE_63 {
+ int qsize ;
+ int occupied ;
+ pthread_mutex_t mtx ;
+};
+typedef struct __anonstruct_PQUEUE_63 PQUEUE;
+
+PQUEUE pqb ;
+
+int pqueue_init(PQUEUE *qp , int qsize )
+{
+ qp->qsize = qsize;
+ qp->occupied = 0;
+ pthread_mutex_init(& qp->mtx, NULL);
+ return (0);
+}
+
+int pqueue_put(PQUEUE *qp)
+{
+ pthread_mutex_lock(& qp->mtx);
+ while (qp->occupied >= qp->qsize) {
+
+ }
+ assert(qp->occupied >= 0); // TODO
+ (qp->occupied) ++;
+ pthread_mutex_unlock(& qp->mtx);
+ return (1);
+}
+
+int pqueue_get(PQUEUE *qp)
+{
+ int got = 0;
+ pthread_mutex_lock(& qp->mtx);
+ while (qp->occupied <= 0) {
+
+ }
+ assert(qp->occupied > 0); // TODO
+ if (qp->occupied > 0) {
+ (qp->occupied) --;
+ got = 1;
+ pthread_mutex_unlock(& qp->mtx);
+ } else {
+ pthread_mutex_unlock(& qp->mtx);
+ }
+ return (got);
+}
+
+
+void *worker(void *arg )
+{
+ while (1) {
+ pqueue_get(& pqb);
+ }
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+ int qsize;
+
+ PQUEUE *qp = &pqb;
+ pqueue_init(& pqb, qsize);
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ for (int i = 1; i < argc; i++) {
+ pqueue_put(& pqb);
+ }
+ return 0;
+}
diff --git a/tests/regression/13-privatized/54-widen-dependent.c b/tests/regression/13-privatized/54-widen-dependent.c
new file mode 100644
index 0000000000..677ffd1be4
--- /dev/null
+++ b/tests/regression/13-privatized/54-widen-dependent.c
@@ -0,0 +1,38 @@
+// PARAM: --enable ana.int.interval --enable exp.priv-distr-init
+#include
+#include
+
+// protection priv succeeds
+// write fails due to [1,1] widen [0,1] -> [-inf,1]
+// sensitive to eval and widen order!
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void *worker(void *arg )
+{
+ pthread_mutex_lock(&A);
+ while (g <= 0) {
+
+ }
+ assert(g > 0); // TODO
+ g--;
+ pthread_mutex_unlock(&A);
+ return NULL;
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ pthread_mutex_lock(&A);
+ while (g >= 10) {
+
+ }
+ assert(g >= 0); // TODO
+ g++;
+ pthread_mutex_unlock(&A);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/55-widen-dependent-local.c b/tests/regression/13-privatized/55-widen-dependent-local.c
new file mode 100644
index 0000000000..796cef86e9
--- /dev/null
+++ b/tests/regression/13-privatized/55-widen-dependent-local.c
@@ -0,0 +1,43 @@
+// PARAM: --enable ana.int.interval --enable exp.priv-distr-init
+#include
+#include
+
+// protection priv succeeds
+// write fails due to [1,+inf] widen ([1,+inf] join [0,+inf]) -> [-inf,+inf]
+// sensitive to eval and widen order!
+
+int g = 0;
+int limit; // unknown
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void *worker(void *arg )
+{
+ // just for going to multithreaded mode
+ return NULL;
+}
+
+int put() {
+ pthread_mutex_lock(&A);
+ while (g >= limit) { // problematic widen
+
+ }
+ assert(g >= 0); // TODO
+ g++;
+ pthread_mutex_unlock(&A);
+}
+
+int main(int argc , char **argv )
+{
+ pthread_t tid;
+ pthread_create(& tid, NULL, & worker, NULL);
+
+ int r;
+ limit = r; // only problematic if limit unknown
+
+ while (1) {
+ // only problematic if not inlined
+ put();
+ }
+ return 0;
+}
diff --git a/tests/regression/13-privatized/56-aget_extern_init_minimal.c b/tests/regression/13-privatized/56-aget_extern_init_minimal.c
new file mode 100644
index 0000000000..d9f5bc0af9
--- /dev/null
+++ b/tests/regression/13-privatized/56-aget_extern_init_minimal.c
@@ -0,0 +1,25 @@
+// SKIP
+#include
+#include
+
+extern int optind ;
+
+pthread_t hthread ;
+
+void *signal_waiter(void *arg )
+{
+}
+
+int main(int argc , char **argv )
+{
+ pthread_create(& hthread, NULL, & signal_waiter, NULL);
+
+ if (optind >= argc) {
+ if (optind == argc) {
+ // lock priv should also read Unknown int, not Unknown here
+ exit(1);
+ }
+ }
+
+ return (0);
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/57-singlethreaded-unlock.c b/tests/regression/13-privatized/57-singlethreaded-unlock.c
new file mode 100644
index 0000000000..2ff72c3fe0
--- /dev/null
+++ b/tests/regression/13-privatized/57-singlethreaded-unlock.c
@@ -0,0 +1,25 @@
+#include
+#include
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ // just for going to multithreaded mode
+ return NULL;
+}
+
+int main() {
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_unlock(&A); // singlethreaded mode unlock
+
+ g = 2;
+
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+
+ assert(g == 2);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/58-singlethreaded-lock.c b/tests/regression/13-privatized/58-singlethreaded-lock.c
new file mode 100644
index 0000000000..ab39f7abc2
--- /dev/null
+++ b/tests/regression/13-privatized/58-singlethreaded-lock.c
@@ -0,0 +1,29 @@
+// PARAM: --enable ana.int.enums --enable ana.int.interval
+#include
+#include
+
+int g = 0;
+
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void *t_fun(void *arg) {
+ // just for going to multithreaded mode
+ return NULL;
+}
+
+int main() {
+ pthread_mutex_lock(&A);
+ g = 1;
+ pthread_mutex_unlock(&A); // singlethreaded mode unlock
+
+ g = 2;
+
+ pthread_mutex_lock(&A);
+
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL); // enter multithreaded mode with nonempty lockset
+
+ g = 3; // write under mutex which was locked during singlethreaded mode
+ assert(g == 3);
+ return 0;
+}
diff --git a/tests/regression/13-privatized/59-smtprc_threadenter_path_minimal.c b/tests/regression/13-privatized/59-smtprc_threadenter_path_minimal.c
new file mode 100644
index 0000000000..5a9342cfd0
--- /dev/null
+++ b/tests/regression/13-privatized/59-smtprc_threadenter_path_minimal.c
@@ -0,0 +1,54 @@
+#include
+
+struct options {
+ unsigned short number_of_threads ;
+ unsigned short cur_threads ;
+};
+
+struct flags {
+ unsigned char debug ;
+};
+
+struct options o ;
+struct flags f ;
+
+int cleaner_start(void)
+{
+ // make unknown
+ int r;
+ o.cur_threads = r;
+ o.number_of_threads = r;
+ f.debug = r;
+ return 0;
+}
+
+int thread_start()
+{
+ return 0;
+}
+
+pthread_mutex_t main_thread_count_mutex = PTHREAD_MUTEX_INITIALIZER;
+
+int main(int argc , char **argv )
+{
+ pthread_t c_tid ;
+ pthread_create(& c_tid, NULL, & cleaner_start, NULL);
+
+
+ int x = 0;
+
+
+ pthread_mutex_lock(& main_thread_count_mutex);
+ while ((int )o.cur_threads >= (int )o.number_of_threads) {
+ pthread_mutex_unlock(& main_thread_count_mutex);
+ if (f.debug) {
+ x = 1; // do something
+ }
+ // missing lock?
+ }
+ pthread_mutex_unlock(& main_thread_count_mutex);
+
+ // lock gets here with two paths and crashes
+ pthread_create(& c_tid, NULL, & thread_start, NULL);
+ return (0);
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/60-allfuns-priv.c b/tests/regression/13-privatized/60-allfuns-priv.c
new file mode 100644
index 0000000000..ad80d1a411
--- /dev/null
+++ b/tests/regression/13-privatized/60-allfuns-priv.c
@@ -0,0 +1,14 @@
+// PARAM: --enable allfuns
+#include
+#include
+
+int g = 0;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void f() {
+ pthread_mutex_lock(&A);
+ while (g) {
+ // should be unreachable
+ }
+ assert(g == 0); // should be reachable
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/61-otherfun-priv.c b/tests/regression/13-privatized/61-otherfun-priv.c
new file mode 100644
index 0000000000..37c83c2c74
--- /dev/null
+++ b/tests/regression/13-privatized/61-otherfun-priv.c
@@ -0,0 +1,15 @@
+// PARAM: --sets otherfun[+] f
+// no earlyglobs!
+#include
+#include
+
+int g = 0;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void f() {
+ pthread_mutex_lock(&A);
+ while (g) {
+ // should be unreachable
+ }
+ assert(g == 0); // should be reachable
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/62-global-threadid.c b/tests/regression/13-privatized/62-global-threadid.c
new file mode 100644
index 0000000000..38d21700ea
--- /dev/null
+++ b/tests/regression/13-privatized/62-global-threadid.c
@@ -0,0 +1,15 @@
+#include
+
+pthread_t id;
+
+extern void magic();
+
+void *t_fun(void *arg) {
+ magic(); // invalidates
+ return NULL;
+}
+
+void main() {
+ pthread_create(&id, NULL, t_fun, NULL);
+ // mine-W didn't propagate id properly so invalidation set to top of "wrong" type
+}
diff --git a/tests/regression/13-privatized/63-access-threadspawn-lval.c b/tests/regression/13-privatized/63-access-threadspawn-lval.c
new file mode 100644
index 0000000000..7f98b129ab
--- /dev/null
+++ b/tests/regression/13-privatized/63-access-threadspawn-lval.c
@@ -0,0 +1,28 @@
+#include
+
+pthread_t id1;
+pthread_t id2;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void magic1();
+void magic2();
+
+void e() {
+ pthread_mutex_lock(&A);
+ magic1();
+}
+
+void *f(void *arg) {
+ return NULL;
+}
+
+void *g(void *arg) {
+ magic2(e); // spawns e
+ return NULL;
+}
+
+void main() {
+ // magic1(); // optional?
+ pthread_create(&id1, NULL, f, NULL); // mutex should record id1 access here
+ pthread_create(&id2, NULL, g, NULL); // mutex should record id2 access here
+}
diff --git a/tests/regression/13-privatized/64-access-invalidate.c b/tests/regression/13-privatized/64-access-invalidate.c
new file mode 100644
index 0000000000..7a191a9650
--- /dev/null
+++ b/tests/regression/13-privatized/64-access-invalidate.c
@@ -0,0 +1,21 @@
+#include
+
+pthread_t id;
+pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER;
+
+void magic1();
+void magic2();
+
+void e() {
+ pthread_mutex_lock(&A);
+ magic1();
+}
+
+void *g(void *arg) {
+ magic2(e); // spawns e, mutex should record invalidated A access here
+ return NULL;
+}
+
+void main() {
+ pthread_create(&id, NULL, g, NULL); // mutex should record id access here
+}
diff --git a/tests/regression/13-privatized/65-threadreturn-cpa-remove.c b/tests/regression/13-privatized/65-threadreturn-cpa-remove.c
new file mode 100644
index 0000000000..3bbe85b3ea
--- /dev/null
+++ b/tests/regression/13-privatized/65-threadreturn-cpa-remove.c
@@ -0,0 +1,29 @@
+#include
+
+int d;
+pthread_t g;
+enum { b } c() {}
+void *e() { return &d; }
+h() {}
+
+void j() {
+ int a;
+ e();
+ c();
+ if (a)
+ h();
+}
+
+void f() {
+ pthread_create(&g, NULL, j, NULL);
+}
+
+void *i(void *arg) {
+ f(g);
+ return NULL;
+}
+
+void main() {
+ pthread_t k;
+ pthread_create(&k, NULL, i, NULL);
+}
\ No newline at end of file
diff --git a/tests/regression/13-privatized/66-mine-W-init.c b/tests/regression/13-privatized/66-mine-W-init.c
new file mode 100644
index 0000000000..e416bedee9
--- /dev/null
+++ b/tests/regression/13-privatized/66-mine-W-init.c
@@ -0,0 +1,15 @@
+#include
+#include
+
+int g;
+
+void *t_fun(void *arg) {
+ return NULL;
+}
+
+void main() {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+ g = 1;
+ assert(g); // TODO (Mine's analysis would succeed, our mine-W doesn't)
+}
diff --git a/tests/regression/29-svcomp/10-ptr-cast-write-malloc.c b/tests/regression/29-svcomp/10-ptr-cast-write-malloc.c
index 4fce1cbc4b..8ef5437919 100644
--- a/tests/regression/29-svcomp/10-ptr-cast-write-malloc.c
+++ b/tests/regression/29-svcomp/10-ptr-cast-write-malloc.c
@@ -9,7 +9,7 @@ int main() {
signed char *z = y;
assert(*z == -56);
-
+
// Two
signed char* s = malloc(10*sizeof(signed char));
s[0] = -5;
diff --git a/tests/regression/29-svcomp/16-atomic_priv.c b/tests/regression/29-svcomp/16-atomic_priv.c
index 4f46cf4c07..f7bfa993dc 100644
--- a/tests/regression/29-svcomp/16-atomic_priv.c
+++ b/tests/regression/29-svcomp/16-atomic_priv.c
@@ -21,9 +21,10 @@ void *t_fun(void *arg) {
int main(void) {
pthread_t id;
pthread_create(&id, NULL, t_fun, NULL);
- // __VERIFIER_atomic_begin();
+ assert(myglobal == 5); // TODO
+ __VERIFIER_atomic_begin();
assert(myglobal == 5);
- // __VERIFIER_atomic_end();
+ __VERIFIER_atomic_end();
pthread_join (id, NULL);
return 0;
}
diff --git a/tests/regression/29-svcomp/18-atomic_fun_priv.c b/tests/regression/29-svcomp/18-atomic_fun_priv.c
index 4625167c5f..de7e403610 100644
--- a/tests/regression/29-svcomp/18-atomic_fun_priv.c
+++ b/tests/regression/29-svcomp/18-atomic_fun_priv.c
@@ -21,9 +21,10 @@ void *t_fun(void *arg) {
int main(void) {
pthread_t id;
pthread_create(&id, NULL, t_fun, NULL);
- // __VERIFIER_atomic_begin();
+ assert(myglobal == 5); // TODO
+ __VERIFIER_atomic_begin();
assert(myglobal == 5);
- // __VERIFIER_atomic_end();
+ __VERIFIER_atomic_end();
pthread_join (id, NULL);
return 0;
}
diff --git a/tests/regression/29-svcomp/22-atomic_priv_sound.c b/tests/regression/29-svcomp/22-atomic_priv_sound.c
new file mode 100644
index 0000000000..5a37128936
--- /dev/null
+++ b/tests/regression/29-svcomp/22-atomic_priv_sound.c
@@ -0,0 +1,28 @@
+// PARAM: --enable ana.sv-comp.functions
+#include
+#include
+
+extern void __VERIFIER_atomic_begin();
+extern void __VERIFIER_atomic_end();
+
+int myglobal = 5;
+
+void *t_fun(void *arg) {
+ __VERIFIER_atomic_begin();
+ assert(myglobal == 5); // TODO
+ myglobal++;
+ assert(myglobal == 6); // TODO
+ __VERIFIER_atomic_end();
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id;
+ pthread_create(&id, NULL, t_fun, NULL);
+ assert(myglobal == 5); // UNKNOWN!
+ __VERIFIER_atomic_begin();
+ assert(myglobal == 5); // UNKNOWN!
+ __VERIFIER_atomic_end();
+ pthread_join (id, NULL);
+ return 0;
+}
diff --git a/tests/regression/29-svcomp/23-atomic_priv_sound2.c b/tests/regression/29-svcomp/23-atomic_priv_sound2.c
new file mode 100644
index 0000000000..8220989342
--- /dev/null
+++ b/tests/regression/29-svcomp/23-atomic_priv_sound2.c
@@ -0,0 +1,43 @@
+// PARAM: --enable ana.sv-comp.functions
+#include
+#include
+
+extern void __VERIFIER_atomic_begin();
+extern void __VERIFIER_atomic_end();
+
+int myglobal = 0;
+int myglobal2 = 0;
+int myglobal3 = 0;
+
+void *t_fun(void *arg) {
+ __VERIFIER_atomic_begin();
+ myglobal2++;
+ __VERIFIER_atomic_end();
+ __VERIFIER_atomic_begin();
+ myglobal++;
+ __VERIFIER_atomic_end();
+ return NULL;
+}
+
+void *t2_fun(void *arg) {
+ __VERIFIER_atomic_begin();
+ myglobal3++;
+ __VERIFIER_atomic_end();
+ __VERIFIER_atomic_begin();
+ myglobal++;
+ __VERIFIER_atomic_end();
+ return NULL;
+}
+
+int main(void) {
+ pthread_t id, id2;
+ pthread_create(&id, NULL, t_fun, NULL);
+ pthread_create(&id2, NULL, t2_fun, NULL);
+ assert(myglobal == 2); // UNKNOWN!
+ __VERIFIER_atomic_begin();
+ assert(myglobal == 2); // UNKNOWN!
+ __VERIFIER_atomic_end();
+ pthread_join (id, NULL);
+ pthread_join (id2, NULL);
+ return 0;
+}
diff --git a/tests/regression/31-ikind-aware-ints/06-structs.c b/tests/regression/31-ikind-aware-ints/06-structs.c
index 9d26bb1f28..c801bf4176 100644
--- a/tests/regression/31-ikind-aware-ints/06-structs.c
+++ b/tests/regression/31-ikind-aware-ints/06-structs.c
@@ -1,4 +1,4 @@
-// PARAM: --enable ana.int.interval --enable exp.partition-arrays.enabled --set ana.activated "['base', 'mallocWrapper']"
+// PARAM: --enable ana.int.interval --enable exp.partition-arrays.enabled --set ana.activated "['base', 'threadflag', 'mallocWrapper']"
struct rtl8169_private {
unsigned int features ;
};
diff --git a/tests/regression/expected-priv.txt b/tests/regression/expected-priv.txt
new file mode 100644
index 0000000000..1b0a903373
--- /dev/null
+++ b/tests/regression/expected-priv.txt
@@ -0,0 +1,26 @@
+protection-old:
+9 tests failed: ["13/18 first-reads", "13/19 publish-precision", "13/21 publish-basic", "13/22 traces-paper", "13/23 traces-paper2", "13/48 pfscan_protected_loop_minimal", "13/49 refine-protected-loop", "13/50 pfscan_protected_loop_minimal2", "13/51 refine-protected-loop2"]
+
+protection:
+24 tests failed: ["13/20 publish-regression", "13/24 multiple-protecting", "13/27 multiple-protecting2", "13/28 multiple-protecting2-simple", "13/30 traces-oplus-vs-meet", "13/31 traces-mine-vs-mutex", "13/35 traces-ex-2", "13/37 traces-ex-4", "13/38 traces-ex-4-switch", "13/42 traces-ex-mini", "28/02 simple_racefree", "28/04 munge_racefree", "28/05 lockfuns_racefree", "28/08 cond_racefree", "28/10 ptrmunge_racefree", "28/12 ptr_racefree", "28/20 callback_racefree", "28/28 funptr_racefree", "28/36 indirect_racefree", "28/41 trylock_racefree", "28/42 trylock2_racefree", "28/46 escape_racefree", "28/51 mutexptr_racefree", "28/60 invariant_racefree"]
+
+protection-read:
+No errors :)
+
+protection-vesal:
+2 tests failed: ["13/22 traces-paper", "13/23 traces-paper2"]
+
+write:
+No errors :)
+
+mine-W:
+44 tests failed: ["03/17 struct_priv", "13/01 priv_nr", "13/03 priv_inv", "13/04 priv_multi", "13/17 priv_interval", "13/19 publish-precision", "13/20 publish-regression", "13/21 publish-basic", "13/22 traces-paper", "13/23 traces-paper2", "13/24 multiple-protecting", "13/25 struct_nr", "13/27 multiple-protecting2", "13/28 multiple-protecting2-simple", "13/30 traces-oplus-vs-meet", "13/31 traces-mine-vs-mutex", "13/35 traces-ex-2", "13/36 traces-ex-3", "13/38 traces-ex-4-switch", "13/42 traces-ex-mini", "13/45 traces-per-global-and-current-lock-mine-incomparable", "13/46 refine-protected1", "13/47 refine-protected2", "13/48 pfscan_protected_loop_minimal", "13/49 refine-protected-loop", "13/50 pfscan_protected_loop_minimal2", "13/51 refine-protected-loop2", "13/52 refine-protected-loop2-small", "13/58 singlethreaded-lock", "28/02 simple_racefree", "28/04 munge_racefree", "28/05 lockfuns_racefree", "28/08 cond_racefree", "28/10 ptrmunge_racefree", "28/12 ptr_racefree", "28/20 callback_racefree", "28/28 funptr_racefree", "28/36 indirect_racefree", "28/41 trylock_racefree", "28/42 trylock2_racefree", "28/51 mutexptr_racefree", "28/60 invariant_racefree", "29/16 atomic_priv", "29/18 atomic_fun_priv"]
+
+mine-W-noinit:
+13 tests failed: ["13/20 publish-regression", "13/24 multiple-protecting", "13/27 multiple-protecting2", "13/28 multiple-protecting2-simple", "13/30 traces-oplus-vs-meet", "13/31 traces-mine-vs-mutex", "13/35 traces-ex-2", "13/36 traces-ex-3", "13/38 traces-ex-4-switch", "13/42 traces-ex-mini", "13/45 traces-per-global-and-current-lock-mine-incomparable", "13/61 otherfun-priv", "28/42 trylock2_racefree"]
+
+lock:
+10 tests failed: ["13/20 publish-regression", "13/24 multiple-protecting", "13/30 traces-oplus-vs-meet", "13/35 traces-ex-2", "13/36 traces-ex-3", "13/38 traces-ex-4-switch", "13/42 traces-ex-mini", "13/45 traces-per-global-and-current-lock-mine-incomparable", "13/58 singlethreaded-lock", "28/42 trylock2_racefree"]
+
+write+lock:
+No errors :)
diff --git a/tests/sv-comp/no-overflow.prp b/tests/sv-comp/no-overflow.prp
index 26c5bded7a..02e9f2c4af 100644
--- a/tests/sv-comp/no-overflow.prp
+++ b/tests/sv-comp/no-overflow.prp
@@ -1,2 +1 @@
CHECK( init(main()), LTL(G ! overflow) )
-