4040 val thread_join : ?force : bool -> Q .ask -> (V .t -> G .t ) -> Cil .exp -> BaseComponents (D ).t -> BaseComponents (D ).t
4141 val thread_return : Q .ask -> (V .t -> G .t ) -> (V .t -> G .t -> unit ) -> ThreadIdDomain.Thread .t -> BaseComponents (D ).t -> BaseComponents (D ).t
4242
43+ val invariant_global : (V .t -> G .t ) -> V .t -> Invariant .t
44+
4345 val init : unit -> unit
4446 val finalize : unit -> unit
4547end
@@ -124,6 +126,9 @@ struct
124126
125127 let thread_join ?(force =false ) ask get e st = st
126128 let thread_return ask get set tid st = st
129+
130+ let invariant_global getg g =
131+ ValueDomain. invariant_global getg g
127132end
128133
129134module PerMutexPrivBase =
@@ -156,6 +161,11 @@ struct
156161 | None , Some v -> Some v
157162 | None , None -> None
158163
164+ let read_unprotected_global getg x =
165+ let get_mutex_global_x = get_mutex_global_x_with_mutex_inits getg x in
166+ (* None is VD.top () *)
167+ get_mutex_global_x |? VD. bot ()
168+
159169 let escape ask getg sideg (st : BaseComponents (D).t ) escaped =
160170 let escaped_cpa = CPA. filter (fun x _ -> EscapeDomain.EscapedVars. mem x escaped) st.cpa in
161171 sideg V. mutex_inits escaped_cpa;
@@ -193,6 +203,13 @@ struct
193203
194204 let thread_join ?(force =false ) ask get e st = st
195205 let thread_return ask get set tid st = st
206+
207+ let invariant_global getg g =
208+ match g with
209+ | `Left _ -> (* mutex *)
210+ Invariant. none
211+ | `Right g' -> (* global *)
212+ ValueDomain. invariant_global (read_unprotected_global getg) g'
196213end
197214
198215module PerMutexOplusPriv : S =
@@ -201,8 +218,7 @@ struct
201218
202219 let read_global ask getg (st : BaseComponents (D).t ) x =
203220 if is_unprotected ask x then
204- let get_mutex_global_x = get_mutex_global_x_with_mutex_inits getg x in
205- get_mutex_global_x |? VD. bot ()
221+ read_unprotected_global getg x
206222 else
207223 CPA. find x st.cpa
208224 (* let read_global ask getg cpa x =
@@ -271,9 +287,8 @@ struct
271287
272288 let read_global ask getg (st : BaseComponents (D).t ) x =
273289 if is_unprotected ask x then (
274- let get_mutex_global_x = get_mutex_global_x_with_mutex_inits getg x in
275290 (* If the global is unprotected, all appropriate information should come via the appropriate globals, local value may be too small due to stale values surviving widening *)
276- get_mutex_global_x |? VD. bot ()
291+ read_unprotected_global getg x
277292 )
278293 else
279294 CPA. find x st.cpa
@@ -550,6 +565,21 @@ struct
550565 let _,lmust,l = st.priv in
551566 {st with cpa = new_cpa; priv = (W. bot () ,lmust,l)}
552567
568+ let read_unprotected_global getg x =
569+ let get_mutex_global_x = merge_all @@ G. mutex @@ getg (V. global x) in
570+ let get_mutex_global_x' = CPA. find x get_mutex_global_x in
571+ let get_mutex_inits = merge_all @@ G. mutex @@ getg V. mutex_inits in
572+ let get_mutex_inits' = CPA. find x get_mutex_inits in
573+ VD. join get_mutex_global_x' get_mutex_inits'
574+
575+ let invariant_global getg g =
576+ match g with
577+ | `Left (`Left _ ) -> (* mutex *)
578+ Invariant. none
579+ | `Left (`Right g' ) -> (* global *)
580+ ValueDomain. invariant_global (read_unprotected_global getg) g'
581+ | `Right _ -> (* thread *)
582+ Invariant. none
553583end
554584
555585
@@ -690,6 +720,13 @@ struct
690720 vf (V. unprotected g);
691721 vf (V. protected g);
692722 | _ -> ()
723+
724+ let invariant_global getg g =
725+ match g with
726+ | `Left g' -> (* unprotected *)
727+ ValueDomain. invariant_global (fun g -> getg (V. unprotected g)) g'
728+ | `Right g -> (* protected *)
729+ Invariant. none
693730end
694731
695732module AbstractLockCenteredGBase (WeakRange : Lattice.S ) (SyncRange : Lattice.S ) =
@@ -725,11 +762,42 @@ struct
725762 end
726763end
727764
728- module LockCenteredGBase =
765+ module type WeakRangeS =
766+ sig
767+ include Lattice. S
768+ val fold_weak : (VD .t -> 'a -> 'a ) -> t -> 'a -> 'a
769+ (* * Fold over all values represented by weak range. *)
770+ end
771+
772+ module AbstractLockCenteredBase (WeakRange : WeakRangeS ) (SyncRange : Lattice.S ) =
729773struct
774+ include AbstractLockCenteredGBase (WeakRange ) (SyncRange )
775+ include MutexGlobals
776+
777+ let invariant_global getg g =
778+ match g with
779+ | `Left _ -> (* mutex *)
780+ Invariant. none
781+ | `Right g' -> (* global *)
782+ ValueDomain. invariant_global (fun x ->
783+ GWeak. fold (fun s' tm acc ->
784+ WeakRange. fold_weak VD. join tm acc
785+ ) (G. weak (getg (V. global x))) (VD. bot () )
786+ ) g'
787+ end
788+
789+ module LockCenteredBase =
790+ struct
791+ module VD =
792+ struct
793+ include VD
794+
795+ let fold_weak f v a = f v a
796+ end
797+
730798 (* weak: G -> (2^M -> D) *)
731799 (* sync: M -> (2^M -> (G -> D)) *)
732- include AbstractLockCenteredGBase (VD ) (CPA )
800+ include AbstractLockCenteredBase (VD ) (CPA )
733801end
734802
735803module MinePrivBase =
@@ -760,11 +828,16 @@ struct
760828 open Locksets
761829
762830 module Thread = ThreadIdDomain. Thread
763- module ThreadMap = MapDomain. MapBot (Thread ) (VD )
831+ module ThreadMap =
832+ struct
833+ include MapDomain. MapBot (Thread ) (VD )
834+
835+ let fold_weak f m a = fold (fun _ v a -> f v a) m a
836+ end
764837
765838 (* weak: G -> (2^M -> (T -> D)) *)
766839 (* sync: M -> (2^M -> (G -> D)) *)
767- include AbstractLockCenteredGBase (ThreadMap ) (CPA )
840+ include AbstractLockCenteredBase (ThreadMap ) (CPA )
768841
769842 let global_init_thread = RichVarinfo. single ~name: " global_init"
770843 let current_thread (ask : Q.ask ): Thread.t =
831904module MineNoThreadPriv : S =
832905struct
833906 include MineNaivePrivBase
834- include LockCenteredGBase
907+ include LockCenteredBase
835908 open Locksets
836909
837910 let read_global ask getg (st : BaseComponents (D).t ) x =
893966module MineWPriv (Param : MineWPrivParam ): S =
894967struct
895968 include MinePrivBase
896- include LockCenteredGBase
969+ include LockCenteredBase
897970 open Locksets
898971
899972 module W =
9961069module LockCenteredPriv : S =
9971070struct
9981071 include MinePrivBase
999- include LockCenteredGBase
1072+ include LockCenteredBase
10001073 open Locksets
10011074
10021075 open LockCenteredD
@@ -1124,23 +1197,28 @@ struct
11241197 let threadenter = startstate_threadenter startstate
11251198end
11261199
1127- module WriteCenteredGBase =
1200+ module WriteCenteredBase =
11281201struct
11291202 open Locksets
11301203
1131- module GWeakW = MapDomain. MapBot (Lockset ) (VD )
1204+ module GWeakW =
1205+ struct
1206+ include MapDomain. MapBot (Lockset ) (VD )
1207+
1208+ let fold_weak f m a = fold (fun _ v a -> f v a) m a
1209+ end
11321210 module GSyncW = MapDomain. MapBot (Lockset ) (CPA )
11331211
11341212 (* weak: G -> (S:2^M -> (W:2^M -> D)) *)
11351213 (* sync: M -> (S:2^M -> (W:2^M -> (G -> D))) *)
1136- include AbstractLockCenteredGBase (GWeakW ) (GSyncW )
1214+ include AbstractLockCenteredBase (GWeakW ) (GSyncW )
11371215end
11381216
11391217(* * Write-Centered Reading. *)
11401218module WriteCenteredPriv : S =
11411219struct
11421220 include MinePrivBase
1143- include WriteCenteredGBase
1221+ include WriteCenteredBase
11441222 open Locksets
11451223
11461224 open WriteCenteredD
@@ -1280,7 +1358,7 @@ end
12801358module WriteAndLockCenteredPriv : S =
12811359struct
12821360 include MinePrivBase
1283- include WriteCenteredGBase
1361+ include WriteCenteredBase
12841362 open Locksets
12851363
12861364 open LockCenteredD
@@ -1462,6 +1540,7 @@ struct
14621540 let enter_multithreaded ask getg sideg st = time " enter_multithreaded" (Priv. enter_multithreaded ask getg sideg) st
14631541 let threadenter ask st = time " threadenter" (Priv. threadenter ask) st
14641542 let iter_sys_vars getg vq vf = time " iter_sys_vars" (Priv. iter_sys_vars getg vq) vf
1543+ let invariant_global getg v = time " invariant_global" (Priv. invariant_global getg) v
14651544
14661545 let thread_join ?(force =false ) ask get e st = time " thread_join" (Priv. thread_join ~force ask get e) st
14671546 let thread_return ask get set tid st = time " thread_return" (Priv. thread_return ask get set tid) st
0 commit comments