@@ -79,6 +79,7 @@ module rec Compound: S with type t = [
7979 | `Array of CArrays. t
8080 | `Blob of Blobs. t
8181 | `Thread of Threads. t
82+ | `Mutex
8283 | `Bot
8384 ] and type offs = (fieldinfo,IndexDomain. t) Lval. offs =
8485struct
9293 | `Array of CArrays .t
9394 | `Blob of Blobs .t
9495 | `Thread of Threads .t
96+ | `Mutex
9597 | `Bot
9698 ] [@@ deriving eq , ord , hash ]
9799
@@ -108,6 +110,7 @@ struct
108110
109111 let rec bot_value (t : typ ): t =
110112 match t with
113+ | _ when is_mutex_type t -> `Mutex
111114 | TInt _ -> `Bot (* `Int (ID.bot ()) -- should be lower than any int or address*)
112115 | TFloat _ -> `Bot
113116 | TPtr _ -> `Address (AD. bot () )
@@ -132,12 +135,13 @@ struct
132135 | `Array x -> CArrays. is_bot x
133136 | `Blob x -> Blobs. is_bot x
134137 | `Thread x -> Threads. is_bot x
138+ | `Mutex -> true
135139 | `Bot -> true
136140 | `Top -> false
137141
138142 let rec init_value (t : typ ): t = (* top_value is not used here because structs, blob etc will not contain the right members *)
139143 match t with
140- | t when is_mutex_type t -> `Top
144+ | t when is_mutex_type t -> `Mutex
141145 | TInt (ik ,_ ) -> `Int (ID. top_of ik)
142146 | TFloat ((FFloat | FDouble | FLongDouble as fkind ), _ ) -> `Float (FD. top_of fkind)
143147 | TPtr _ -> `Address AD. top_ptr
@@ -154,6 +158,7 @@ struct
154158
155159 let rec top_value (t : typ ): t =
156160 match t with
161+ | _ when is_mutex_type t -> `Mutex
157162 | TInt (ik ,_ ) -> `Int (ID. (cast_to ik (top_of ik)))
158163 | TFloat ((FFloat | FDouble | FLongDouble as fkind ), _ ) -> `Float (FD. top_of fkind)
159164 | TPtr _ -> `Address AD. top_ptr
@@ -177,11 +182,13 @@ struct
177182 | `Array x -> CArrays. is_top x
178183 | `Blob x -> Blobs. is_top x
179184 | `Thread x -> Threads. is_top x
185+ | `Mutex -> true
180186 | `Top -> true
181187 | `Bot -> false
182188
183189 let rec zero_init_value (t :typ ): t =
184190 match t with
191+ | _ when is_mutex_type t -> `Mutex
185192 | TInt (ikind , _ ) -> `Int (ID. of_int ikind BI. zero)
186193 | TFloat ((FFloat | FDouble | FLongDouble as fkind ), _ ) -> `Float (FD. of_const fkind 0.0 )
187194 | TPtr _ -> `Address AD. null_ptr
@@ -206,7 +213,7 @@ struct
206213 | _ -> `Top
207214
208215 let tag_name : t -> string = function
209- | `Top -> " Top" | `Int _ -> " Int" | `Float _ -> " Float" | `Address _ -> " Address" | `Struct _ -> " Struct" | `Union _ -> " Union" | `Array _ -> " Array" | `Blob _ -> " Blob" | `Thread _ -> " Thread" | `Bot -> " Bot"
216+ | `Top -> " Top" | `Int _ -> " Int" | `Float _ -> " Float" | `Address _ -> " Address" | `Struct _ -> " Struct" | `Union _ -> " Union" | `Array _ -> " Array" | `Blob _ -> " Blob" | `Thread _ -> " Thread" | `Mutex -> " Mutex " | ` Bot -> " Bot"
210217
211218 include Printable. Std
212219 let name () = " compound"
@@ -231,6 +238,7 @@ struct
231238 | `Array n -> CArrays. pretty () n
232239 | `Blob n -> Blobs. pretty () n
233240 | `Thread n -> Threads. pretty () n
241+ | `Mutex -> text " mutex"
234242 | `Bot -> text bot_name
235243 | `Top -> text top_name
236244
@@ -244,6 +252,7 @@ struct
244252 | `Array n -> CArrays. show n
245253 | `Blob n -> Blobs. show n
246254 | `Thread n -> Threads. show n
255+ | `Mutex -> " mutex"
247256 | `Bot -> bot_name
248257 | `Top -> top_name
249258
@@ -363,7 +372,8 @@ struct
363372 (* if v = `Bot || (match torg with Some x -> is_safe_cast t x | None -> false) then v else*)
364373 match v with
365374 | `Bot
366- | `Thread _ ->
375+ | `Thread _
376+ | `Mutex ->
367377 v
368378 | _ ->
369379 let log_top (_ ,l ,_ ,_ ) = Messages. tracel " cast" " log_top at %d: %a to %a is top!\n " l pretty v d_type t in
@@ -473,6 +483,7 @@ struct
473483 | (`Thread x , `Thread y ) -> Threads. leq x y
474484 | (`Int x , `Thread y ) -> true
475485 | (`Address x , `Thread y ) -> true
486+ | (`Mutex, `Mutex) -> true
476487 | _ -> warn_type " leq" x y; false
477488
478489 let rec join x y =
@@ -504,6 +515,7 @@ struct
504515 | (`Address x, `Thread y)
505516 | (`Thread y , `Address x ) ->
506517 `Thread y (* TODO: ignores address! *)
518+ | (`Mutex, `Mutex) -> `Mutex
507519 | _ ->
508520 warn_type " join" x y;
509521 `Top
@@ -539,6 +551,7 @@ struct
539551 | (`Address x, `Thread y)
540552 | (`Thread y , `Address x ) ->
541553 `Thread y (* TODO: ignores address! *)
554+ | (`Mutex, `Mutex) -> `Mutex
542555 | _ ->
543556 warn_type " join" x y;
544557 `Top
@@ -571,6 +584,7 @@ struct
571584 | (`Address x, `Thread y)
572585 | (`Thread y , `Address x ) ->
573586 `Thread y (* TODO: ignores address! *)
587+ | (`Mutex, `Mutex) -> `Mutex
574588 | _ ->
575589 warn_type " widen" x y;
576590 `Top
@@ -598,6 +612,7 @@ struct
598612 | (`Thread x , `Thread y ) -> Threads. leq x y
599613 | (`Int x , `Thread y ) -> true
600614 | (`Address x , `Thread y ) -> true
615+ | (`Mutex, `Mutex) -> true
601616 | _ -> warn_type " leq" x y; false
602617
603618 let rec meet x y =
@@ -622,6 +637,7 @@ struct
622637 | (`Address x, `Thread y)
623638 | (`Thread y , `Address x ) ->
624639 `Address x (* TODO: ignores thread! *)
640+ | (`Mutex, `Mutex) -> `Mutex
625641 | _ ->
626642 warn_type " meet" x y;
627643 `Bot
@@ -653,6 +669,7 @@ struct
653669 | (`Address x, `Thread y)
654670 | (`Thread y , `Address x ) ->
655671 `Thread y (* TODO: ignores address! *)
672+ | (`Mutex, `Mutex) -> `Mutex
656673 | _ ->
657674 warn_type " widen" x y;
658675 `Top
@@ -675,6 +692,7 @@ struct
675692 | (`Address x, `Thread y)
676693 | (`Thread y , `Address x ) ->
677694 `Address x (* TODO: ignores thread! *)
695+ | (`Mutex, `Mutex) -> `Mutex
678696 | x , `Top | `Top , x -> x
679697 | x , `Bot | `Bot , x -> `Bot
680698 | _ ->
@@ -895,6 +913,8 @@ struct
895913 let mu = function `Blob (`Blob (y , s' , orig ), s , orig2 ) -> `Blob (y, ID. join s s',orig) | x -> x in
896914 let r =
897915 match x, offs with
916+ | `Mutex , _ -> (* hide mutex structure contents, not updated anyway *)
917+ `Mutex
898918 | `Blob (x ,s ,orig ), `Index (_ ,ofs ) ->
899919 begin
900920 let l', o' = shift_one_over l o in
@@ -1111,6 +1131,7 @@ struct
11111131 | `Array n -> CArrays. printXml f n
11121132 | `Blob n -> Blobs. printXml f n
11131133 | `Thread n -> Threads. printXml f n
1134+ | `Mutex -> BatPrintf. fprintf f " <value>\n <data>\n mutex\n </data>\n </value>\n "
11141135 | `Bot -> BatPrintf. fprintf f " <value>\n <data>\n bottom\n </data>\n </value>\n "
11151136 | `Top -> BatPrintf. fprintf f " <value>\n <data>\n top\n </data>\n </value>\n "
11161137
@@ -1123,6 +1144,7 @@ struct
11231144 | `Array n -> CArrays. to_yojson n
11241145 | `Blob n -> Blobs. to_yojson n
11251146 | `Thread n -> Threads. to_yojson n
1147+ | `Mutex -> `String " mutex"
11261148 | `Bot -> `String " ⊥"
11271149 | `Top -> `String " ⊤"
11281150
@@ -1139,6 +1161,7 @@ struct
11391161 | `Array n -> `Array (project_arr p n)
11401162 | `Blob (v , s , z ) -> `Blob (project p v, ID. project p s, z)
11411163 | `Thread n -> `Thread n
1164+ | `Mutex -> `Mutex
11421165 | `Bot -> `Bot
11431166 | `Top -> `Top
11441167 and project_addr p a =
0 commit comments