Skip to content

Commit

Permalink
add program generation
Browse files Browse the repository at this point in the history
  • Loading branch information
bartoszmodelski committed Apr 24, 2023
1 parent 0a2a617 commit fcea188
Show file tree
Hide file tree
Showing 6 changed files with 361 additions and 3 deletions.
5 changes: 5 additions & 0 deletions src/trace_tracker.ml
Original file line number Diff line number Diff line change
Expand Up @@ -104,3 +104,8 @@ let equal t1 t2 =
(* any values under the same key are known to be equivalent, even if the exact sequence is not identical *))
t1 t2
== 0


let subset t1 t2 =
TraceMap.fold (fun key _ seen_all ->
TraceMap.mem key t2 && seen_all) t1 true
1 change: 1 addition & 0 deletions src/trace_tracker.mli
Original file line number Diff line number Diff line change
Expand Up @@ -7,3 +7,4 @@ val print_traces : out_channel -> unit
val print : t -> out_channel -> unit
val equal : t -> t -> bool
val get_deps_str : t -> string
val subset : t -> t -> bool
27 changes: 25 additions & 2 deletions src/tracedAtomic.ml
Original file line number Diff line number Diff line change
Expand Up @@ -310,6 +310,22 @@ let do_run init_func init_schedule =
backtrack = IntSet.empty;
}

let rec explore_random func state =
let s = last_element state in
let enabled = IntSet.to_seq s.enabled |> List.of_seq in
let len = List.length enabled in
if len == 0 then ()
else
let random_index = Random.int (List.length enabled) in
let j = List.nth enabled random_index in
let j_proc = List.nth s.procs j in
let schedule =
List.map (fun s -> (s.run_proc, s.run_op, s.run_ptr)) state
@ [ (j, j_proc.op, j_proc.obj_ptr) ]
in
let statedash = state @ [ do_run func schedule ] in
explore_random func statedash

let rec explore func state clock last_access =
let s = last_element state in
List.iter
Expand Down Expand Up @@ -371,18 +387,25 @@ let reset_state () =

let dscheck_trace_file_env = Sys.getenv_opt "dscheck_trace_file"

let random func iters =
reset_state ();
let empty_state = do_run func [ (0, Start, None) ] :: [] in
for _ = 1 to iters do
explore_random func empty_state
done

let dpor func =
reset_state ();
let empty_state = do_run func [ (0, Start, None) ] :: [] in
let empty_clock = IntMap.empty in
let empty_last_access = IntMap.empty in
explore func empty_state empty_clock empty_last_access

let trace ?interleavings ?(record_traces = false) func =
let trace ?(impl = `Dpor) ?interleavings ?(record_traces = false) func =
record_traces_flag := record_traces || Option.is_some dscheck_trace_file_env;
interleavings_chan := interleavings;

dpor func;
(match impl with `Dpor -> dpor func | `Random iters -> random func iters);

(* print reports *)
(match !interleavings_chan with
Expand Down
6 changes: 5 additions & 1 deletion src/tracedAtomic.mli
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,11 @@ val decr : int t -> unit
(** [decr r] atomically decrements the value of [r] by [1]. *)

val trace :
?interleavings:out_channel -> ?record_traces:bool -> (unit -> unit) -> unit
?impl:[ `Random of int | `Dpor ] ->
?interleavings:out_channel ->
?record_traces:bool ->
(unit -> unit) ->
unit
(** start the simulation trace *)

val spawn : (unit -> unit) -> unit
Expand Down
5 changes: 5 additions & 0 deletions tests/dune
Original file line number Diff line number Diff line change
Expand Up @@ -37,3 +37,8 @@
(name test_conditional2)
(libraries dscheck alcotest)
(modules test_conditional2))

(executable
(name gen_program)
(libraries dscheck)
(modules gen_program))
Loading

0 comments on commit fcea188

Please sign in to comment.