@@ -13,6 +13,8 @@ open Analyses
1313
1414module VarSet = SetDomain. Make (Basetype. Variables )
1515
16+ type access_kind = Read | Write
17+
1618module Spec =
1719struct
1820 module Arg =
@@ -59,47 +61,51 @@ struct
5961
6062 let name () = " strong protection * weak protection"
6163
62- let get ~write protection (s ,w ) =
64+ let get ~kind protection (s ,w ) =
6365 let (rw, w) = match protection with
6466 | Queries.Protection. Strong -> s
6567 | Weak -> w
6668 in
67- if write then w else rw
69+ match kind with
70+ | Queries.ProtectionKind. Write -> w
71+ | ReadWrite -> rw
6872 end
6973
7074 (* * Collects information about which variables are protected by which mutexes *)
7175 module GProtecting : sig
7276 include Lattice. S
73- val make : write : bool -> recovered :bool -> MustLockset .t -> t
74- val get : write : bool -> Queries.Protection .t -> t -> MustLockset .t
77+ val make : kind : access_kind -> recovered :bool -> MustLockset .t -> t
78+ val get : kind : Queries . ProtectionKind . t -> Queries.Protection .t -> t -> MustLockset .t
7579 end = struct
7680 include MakeP (MustLockset )
7781
78- let make ~write ~recovered locks =
79- (* If the access is not a write, set to T so intersection with current write-protecting is identity *)
80- let wlocks = if write then locks else MustLockset. all () in
82+ let make ~(kind : access_kind ) ~recovered locks =
83+ let locks =
84+ match kind with
85+ | Write -> (locks, locks)
86+ | Read -> (locks, MustLockset. all () ) (* If the access is not a write, set to T so intersection with current write-protecting is identity *)
87+ in
8188 if recovered then
8289 (* If we are in single-threaded mode again, this does not need to be added to set of mutexes protecting in mt-mode only *)
83- (( locks, wlocks) , (MustLockset. all () , MustLockset. all () ))
90+ (locks, (MustLockset. all () , MustLockset. all () ))
8491 else
85- (( locks, wlocks), ( locks, wlocks) )
92+ (locks, locks)
8693 end
8794
8895
8996 (* * Collects information about which mutex protects which variable *)
9097 module GProtected : sig
9198 include Lattice. S
92- val make : write : bool -> VarSet .t -> t
93- val get : write : bool -> Queries.Protection .t -> t -> VarSet .t
99+ val make : kind : Queries . ProtectionKind . t -> VarSet .t -> t
100+ val get : kind : Queries . ProtectionKind . t -> Queries.Protection .t -> t -> VarSet .t
94101 end = struct
95102 include MakeP (VarSet )
96103
97- let make ~write vs =
104+ let make ~kind vs =
98105 let vs_empty = VarSet. empty () in
99- if write then
100- ((vs_empty, vs), (vs_empty, vs))
101- else
102- ((vs, vs_empty), (vs, vs_empty))
106+ match kind with
107+ | Queries.ProtectionKind. Write -> ((vs_empty, vs), (vs_empty, vs))
108+ | ReadWrite -> ((vs, vs_empty), (vs, vs_empty))
103109 end
104110
105111 module G =
@@ -198,43 +204,43 @@ struct
198204 let query (man : (D.t, _, _, V.t) man ) (type a ) (q : a Queries.t ): a Queries.result =
199205 let ls, m = man.local in
200206 (* get the set of mutexes protecting the variable v in the given mode *)
201- let protecting ~write mode v = GProtecting. get ~write mode (G. protecting (man.global (V. protecting v))) in
207+ let protecting ~kind mode v = GProtecting. get ~kind mode (G. protecting (man.global (V. protecting v))) in
202208 match q with
203209 | Queries. MayBePublic _ when MustLocksetRW. is_all ls -> false
204- | Queries. MayBePublic {global =v ; write ; protection} ->
210+ | Queries. MayBePublic {global =v ; kind ; protection} ->
205211 let held_locks = MustLocksetRW. to_must_lockset (MustLocksetRW. filter snd ls) in
206- let protecting = protecting ~write protection v in
212+ let protecting = protecting ~kind protection v in
207213 (* TODO: unsound in 29/24, why did we do this before? *)
208214 (* if Mutexes.mem verifier_atomic (Lockset.export_locks man.local) then
209215 false
210216 else *)
211217 MustLockset. disjoint held_locks protecting
212218 | Queries. MayBePublicWithout _ when MustLocksetRW. is_all ls -> false
213- | Queries. MayBePublicWithout {global =v ; write ; without_mutex; protection} ->
219+ | Queries. MayBePublicWithout {global =v ; kind ; without_mutex; protection} ->
214220 let held_locks = MustLockset. remove without_mutex (MustLocksetRW. to_must_lockset ls) in
215- let protecting = protecting ~write protection v in
221+ let protecting = protecting ~kind protection v in
216222 (* TODO: unsound in 29/24, why did we do this before? *)
217223 (* if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) man.local)) then
218224 false
219225 else *)
220226 MustLockset. disjoint held_locks protecting
221- | Queries. MustBeProtectedBy {mutex = ml ; global =v ; write ; protection} ->
222- let protecting = protecting ~write protection v in
227+ | Queries. MustBeProtectedBy {mutex = ml ; global =v ; kind ; protection} ->
228+ let protecting = protecting ~kind protection v in
223229 (* TODO: unsound in 29/24, why did we do this before? *)
224230 (* if LockDomain.Addr.equal mutex (LockDomain.Addr.of_var LF.verifier_atomic_var) then
225231 true
226232 else *)
227233 MustLockset. mem ml protecting
228- | Queries. MustProtectingLocks {global; write } ->
229- protecting ~write Strong global
234+ | Queries. MustProtectingLocks {global; kind } ->
235+ protecting ~kind Strong global
230236 | Queries. MustLockset ->
231237 let held_locks = MustLocksetRW. to_must_lockset (MustLocksetRW. filter snd ls) in
232238 held_locks
233239 | Queries. MustBeAtomic ->
234240 let held_locks = MustLocksetRW. to_must_lockset (MustLocksetRW. filter snd ls) in
235241 MustLockset. mem (LF. verifier_atomic_var, `NoOffset ) held_locks (* TODO: Mval.of_var *)
236- | Queries. MustProtectedVars {mutex; write } ->
237- let protected = GProtected. get ~write Strong (G. protected (man.global (V. protected mutex))) in
242+ | Queries. MustProtectedVars {mutex; kind } ->
243+ let protected = GProtected. get ~kind Strong (G. protected (man.global (V. protected mutex))) in
238244 VarSet. fold (fun v acc ->
239245 Queries.VS. add v acc
240246 ) protected (Queries.VS. empty () )
@@ -245,13 +251,13 @@ struct
245251 begin match g with
246252 | `Left g' -> (* protecting *)
247253 if GobConfig. get_bool " dbg.print_protection" then (
248- let protecting = GProtecting. get ~write: false Strong (G. protecting (man.global g)) in (* readwrite protecting *)
254+ let protecting = GProtecting. get ~kind: ReadWrite Strong (G. protecting (man.global g)) in (* readwrite protecting *)
249255 let s = MustLockset. cardinal protecting in
250256 M. info_noloc ~category: Race " Variable %a read-write protected by %d mutex(es): %a" CilType.Varinfo. pretty g' s MustLockset. pretty protecting
251257 )
252258 | `Right m -> (* protected *)
253259 if GobConfig. get_bool " dbg.print_protection" then (
254- let protected = GProtected. get ~write: false Strong (G. protected (man.global g)) in (* readwrite protected *)
260+ let protected = GProtected. get ~kind: ReadWrite Strong (G. protected (man.global g)) in (* readwrite protected *)
255261 let s = VarSet. cardinal protected in
256262 max_protected := max ! max_protected s;
257263 sum_protected := ! sum_protected + s;
@@ -293,25 +299,34 @@ struct
293299 | Some v ->
294300 if not (MustLocksetRW. is_all (fst oman.local)) then
295301 let locks = MustLocksetRW. to_must_lockset (MustLocksetRW. filter snd (fst oman.local)) in
296- let write = match kind with
297- | Write | Free -> true
298- | Read -> false
302+ let kind = match kind with
303+ | Write | Free -> Write
304+ | Read -> Read
299305 | Call
300- | Spawn -> false (* TODO: nonsense? *)
306+ | Spawn -> Read (* TODO: nonsense? *)
301307 in
302- let s = GProtecting. make ~write ~recovered: is_recovered_to_st locks in
308+ let s = GProtecting. make ~kind ~recovered: is_recovered_to_st locks in
303309 man.sideg (V. protecting v) (G. create_protecting s);
304310
305311 if ! AnalysisState. postsolving then (
306- let protecting mode = GProtecting. get ~write mode (G. protecting (man.global (V. protecting v))) in
307- let held_strong = protecting Strong in
308- let held_weak = protecting Weak in
309- let vs = VarSet. singleton v in
310- let protected = G. create_protected @@ GProtected. make ~write vs in
311- MustLockset. iter (fun ml -> man.sideg (V. protected ml) protected) held_strong;
312- (* If the mutex set here is top, it is actually not accessed *)
313- if is_recovered_to_st && not @@ MustLockset. is_all held_weak then
314- MustLockset. iter (fun ml -> man.sideg (V. protected ml) protected) held_weak;
312+ let side_protected kind mode =
313+ let protecting = GProtecting. get ~kind mode (G. protecting (man.global (V. protecting v))) in
314+ (* If the mutex set here is top, it is actually not accessed *)
315+ if not @@ MustLockset. is_all protecting then (
316+ let vs = VarSet. singleton v in
317+ let protected = G. create_protected @@ GProtected. make ~kind vs in
318+ MustLockset. iter (fun ml -> man.sideg (V. protected ml) protected) protecting
319+ )
320+ in
321+ let side_protected kind =
322+ side_protected kind Strong ;
323+ if is_recovered_to_st then
324+ side_protected kind Weak
325+ in
326+ side_protected Queries.ProtectionKind. ReadWrite ;
327+ match kind with
328+ | Write -> side_protected Queries.ProtectionKind. Write
329+ | Read -> ()
315330 )
316331 | None -> M. info ~category: Unsound " Write to unknown address: privatization is unsound."
317332 in
0 commit comments