@@ -296,19 +296,18 @@ let rec explore_source depth func state sleep_sets =
296296 (set_to_str s.backtrack) (set_to_str !sleep) (set_to_str s.enabled); *)
297297 let p_maybe = IntSet. min_elt_opt (IntSet. diff s.enabled ! sleep) in
298298 match p_maybe with
299- | None -> ()
300- (* Printf.printf "[depth=%d] rtn\n%!" depth *)
299+ | None -> () (* Printf.printf "[depth=%d] rtn\n%!" depth *)
301300 | Some p ->
302301 s.backtrack < - IntSet. singleton p;
303302
304303 while IntSet. (cardinal (diff s.backtrack ! sleep)) > 0 do
305304 (* Printf.printf "[depth=%d] loop (backtrack=[%s], sleep=[%s])\n%!" depth
306- (_set_to_str s.backtrack) (_set_to_str !sleep); *)
305+ (_set_to_str s.backtrack) (_set_to_str !sleep); *)
307306 let p = IntSet. min_elt (IntSet. diff s.backtrack ! sleep) in
308307 let proc = List. nth s.procs p in
309308
310309 (* Printf.printf "[depth=%d] p=%d, %s, %s\n%!" depth p
311- (atomic_op_str proc.op) (var_name proc.obj_ptr); *)
310+ (atomic_op_str proc.op) (var_name proc.obj_ptr); *)
312311 (* run *)
313312 let state_top =
314313 let schedule =
@@ -331,137 +330,137 @@ let rec explore_source depth func state sleep_sets =
331330 new_state
332331 in
333332
334- let reversible_races =
335- match reversible_races with
336- | [] -> []
337- | _ -> [ last_element reversible_races ]
333+ let most_recent_race =
334+ match List. rev reversible_races with [] -> None | v :: _ -> Some v
338335 in
339336
340337 (* Printf.printf "[depth=%d] reversible races sz: %d\n%!" depth
341338 (List.length reversible_races); *)
342- for i = 0 to List. length reversible_races - 1 do
343- let e = List. nth reversible_races i in
344- (* Printf.printf
345- "[depth=%d] inner loop, racing op: e=(p'=%d, %s, %s)\n%!" depth
346- e.run_proc (atomic_op_str e.run_op) (var_name e.run_ptr); *)
347- let found_e, prefix_rev, suffix_rev =
348- List. fold_left
349- (fun (seen_e , prefix , suffix ) proc' ->
350- if seen_e then (seen_e, prefix, proc' :: suffix)
351- else if proc' == e then (true , prefix, suffix)
352- else (false , proc' :: prefix, suffix))
353- (false , [] , [] ) state
354- in
355- assert (
356- List. length prefix_rev + List. length suffix_rev
357- = List. length state - 1 );
358- assert found_e;
359-
360- if List. length prefix_rev > 0 then (
361- let prefix (* E' *) = List. rev prefix_rev in
362- (* List.iter
363- (fun proc ->
364- Printf.printf "[depth=%d] ::prefix:: (p=%d, %s, %s)\n%!"
365- depth proc.run_proc
366- (atomic_op_str proc.run_op)
367- (var_name proc.run_ptr))
368- prefix; *)
369- let suffix = List. rev suffix_rev in
370-
371- (* List.iter
372- (fun proc ->
373- Printf.printf "[depth=%d] ::suffix:: (p=%d, %s, %s)\n%!"
374- depth proc.run_proc
375- (atomic_op_str proc.run_op)
376- (var_name proc.run_ptr))
377- suffix; *)
378- let prefix_top = last_element prefix in
379-
339+ (match most_recent_race with
340+ | None -> ()
341+ | Some e ->
380342 (* Printf.printf
381- "[depth=%d] nonempty prefix, prefix_top: (p=%d, %s)\n%!" depth
382- prefix_top.run_proc
383- (atomic_op_str prefix_top.run_op); *)
384- let v_E (* occurs after e but independent of e *) =
385- List. filter
386- (fun proc' ->
387- proc'.run_proc <> e.run_proc
388- && Option. value proc'.run_ptr ~default: (- 1 )
389- <> Option. value e.run_ptr ~default: (- 2 ))
390- suffix
343+ "[depth=%d] inner loop, racing op: e=(p'=%d, %s, %s)\n%!" depth
344+ e.run_proc (atomic_op_str e.run_op) (var_name e.run_ptr); *)
345+ let found_e, prefix_rev, suffix_rev =
346+ List. fold_left
347+ (fun (seen_e , prefix , suffix ) proc' ->
348+ if seen_e then (seen_e, prefix, proc' :: suffix)
349+ else if proc' == e then (true , prefix, suffix)
350+ else (false , proc' :: prefix, suffix))
351+ (false , [] , [] ) state
391352 in
353+ assert (
354+ List. length prefix_rev + List. length suffix_rev
355+ = List. length state - 1 );
356+ assert found_e;
357+
358+ if List. length prefix_rev > 0 then
359+ let prefix (* E' *) = List. rev prefix_rev in
360+ (* List.iter
361+ (fun proc ->
362+ Printf.printf "[depth=%d] ::prefix:: (p=%d, %s, %s)\n%!"
363+ depth proc.run_proc
364+ (atomic_op_str proc.run_op)
365+ (var_name proc.run_ptr))
366+ prefix; *)
367+ let suffix = List. rev suffix_rev in
368+
369+ (* List.iter
370+ (fun proc ->
371+ Printf.printf "[depth=%d] ::suffix:: (p=%d, %s, %s)\n%!"
372+ depth proc.run_proc
373+ (atomic_op_str proc.run_op)
374+ (var_name proc.run_ptr))
375+ suffix; *)
376+ let prefix_top = last_element prefix in
377+
378+ (* Printf.printf
379+ "[depth=%d] nonempty prefix, prefix_top: (p=%d, %s)\n%!" depth
380+ prefix_top.run_proc
381+ (atomic_op_str prefix_top.run_op); *)
382+ let v_E (* occurs after e but independent of e *) =
383+ List. filter
384+ (fun proc' ->
385+ proc'.run_proc <> e.run_proc
386+ && Option. value proc'.run_ptr ~default: (- 1 )
387+ <> Option. value e.run_ptr ~default: (- 2 ))
388+ suffix
389+ in
392390
393- (* List.iter
394- (fun proc ->
395- Printf.printf
396- "[depth=%d] ::occurs_after_e_but_indep:: (p=%d, %s)\n%!"
397- depth proc.run_proc
398- (atomic_op_str proc.run_op))
399- v_E; *)
400- let v = v_E @ [ state_top ] in
401-
402- (* List.iter
403- (fun proc ->
404- Printf.printf "[depth=%d] ::v:: (p=%d, %s)\n%!" depth
405- proc.run_proc
406- (atomic_op_str proc.run_op))
407- v; *)
408- let initials =
409- let initials_map, initials_spawns =
410- List. fold_left
411- (fun (first_accesses , spawns ) (state_cell : state_cell ) ->
412- match state_cell.run_ptr with
413- | None ->
414- let new_spawns =
415- IntSet. add state_cell.run_proc spawns
416- in
417- (first_accesses, new_spawns)
418- | Some obj_ptr ->
419- let new_first_accesses =
420- IntMap. update obj_ptr
421- (function
422- | Some v -> Some v
423- | None -> Some (`Run_proc state_cell.run_proc))
424- first_accesses
425- in
426- (new_first_accesses, spawns))
427- (IntMap. empty, IntSet. empty)
428- v
391+ (* List.iter
392+ (fun proc ->
393+ Printf.printf
394+ "[depth=%d] ::occurs_after_e_but_indep:: (p=%d, %s)\n%!"
395+ depth proc.run_proc
396+ (atomic_op_str proc.run_op))
397+ v_E; *)
398+ let v = v_E @ [ state_top ] in
399+
400+ (* List.iter
401+ (fun proc ->
402+ Printf.printf "[depth=%d] ::v:: (p=%d, %s)\n%!" depth
403+ proc.run_proc
404+ (atomic_op_str proc.run_op))
405+ v; *)
406+ let initials =
407+ let initials_map, initials_spawns =
408+ List. fold_left
409+ (fun (first_accesses , spawns ) (state_cell : state_cell ) ->
410+ match state_cell.run_ptr with
411+ | None ->
412+ let new_spawns =
413+ IntSet. add state_cell.run_proc spawns
414+ in
415+ (first_accesses, new_spawns)
416+ | Some obj_ptr ->
417+ let new_first_accesses =
418+ IntMap. update obj_ptr
419+ (function
420+ | Some v -> Some v
421+ | None -> Some (`Run_proc state_cell.run_proc))
422+ first_accesses
423+ in
424+ (new_first_accesses, spawns))
425+ (IntMap. empty, IntSet. empty)
426+ v
427+ in
428+ IntMap. fold
429+ (fun _obj_ptr (`Run_proc run_proc ) initials_set ->
430+ IntSet. add run_proc initials_set)
431+ initials_map initials_spawns
429432 in
430- IntMap. fold
431- (fun _obj_ptr (`Run_proc run_proc ) initials_set ->
432- IntSet. add run_proc initials_set)
433- initials_map initials_spawns
434- in
435- (*
436- Printf.printf
437- "[depth=%d] initials=[%s], backtrack=[%s] at depth=%d, p=%d, \
438- op=%s \n\
439- %!"
440- depth (_set_to_str initials)
441- (_set_to_str prefix_top.backtrack)
442- (List.length prefix - 1)
443- prefix_top.run_proc
444- (atomic_op_str prefix_top.run_op); *)
445- let prefix_top_sleep =
446- ! (List. nth sleep_sets (List. length prefix - 1 ))
447- in
448- if
449- IntSet. (
450- cardinal
451- (inter prefix_top.backtrack (diff initials prefix_top_sleep)))
452- = 0
453- then (
454- let _initial =
455- match IntSet. (min_elt_opt (diff initials prefix_top_sleep)) with
456- | Some initial -> initial
457- | None -> IntSet. min_elt initials
433+ (*
434+ Printf.printf
435+ "[depth=%d] initials=[%s], backtrack=[%s] at depth=%d, p=%d, \
436+ op=%s \n\
437+ %!"
438+ depth (_set_to_str initials)
439+ (_set_to_str prefix_top.backtrack)
440+ (List.length prefix - 1)
441+ prefix_top.run_proc
442+ (atomic_op_str prefix_top.run_op); *)
443+ let prefix_top_sleep =
444+ ! (List. nth sleep_sets (List. length prefix - 1 ))
458445 in
459- (*
460- Printf.printf "[depth=%d] adding initial to backtrack\n%!"
461- depth; *)
462- prefix_top.backtrack < - IntSet. add _initial prefix_top.backtrack))
463- done ;
464-
446+ if
447+ IntSet. (
448+ cardinal
449+ (inter prefix_top.backtrack
450+ (diff initials prefix_top_sleep)))
451+ = 0
452+ then
453+ let initial =
454+ match
455+ IntSet. (min_elt_opt (diff initials prefix_top_sleep))
456+ with
457+ | Some initial -> initial
458+ | None -> IntSet. min_elt initials
459+ in
460+ (*
461+ Printf.printf "[depth=%d] adding initial to backtrack\n%!"
462+ depth; *)
463+ prefix_top.backtrack < - IntSet. add initial prefix_top.backtrack);
465464 let sleep' =
466465 IntSet. filter
467466 (fun q ->
@@ -476,9 +475,10 @@ let rec explore_source depth func state sleep_sets =
476475 in
477476 explore_source (depth + 1 ) func new_state (sleep_sets @ [ ref sleep' ]);
478477 sleep := IntSet. add p ! sleep
479- done ;;
480- (* Printf.printf "[depth=%d] exit (backtrack=[%s], sleep=[%s])\n%!" depth
481- (_set_to_str s.backtrack) (_set_to_str !sleep) *)
478+ done
479+
480+ (* Printf.printf "[depth=%d] exit (backtrack=[%s], sleep=[%s])\n%!" depth
481+ (_set_to_str s.backtrack) (_set_to_str !sleep) *)
482482
483483let rec explore func state clock last_access =
484484 let s = last_element state in
0 commit comments