aboutsummaryrefslogtreecommitdiffstats
path: root/backend/AuxTools.ml
blob: 1e334524ca674f350e0eaab7e94a42aec0a07879 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
open RTL
open Maps
open Camlcoq

let p2i r = P.to_int r

let get_some = function
  | None -> failwith "Got None instead of Some _"
  | Some thing -> thing

let successors_inst = function
  | Inop n
  | Iop (_, _, _, n)
  | Iload (_, _, _, _, _, n)
  | Istore (_, _, _, _, n)
  | Icall (_, _, _, _, n)
  | Ibuiltin (_, _, _, n) ->
      [ n ]
  | Icond (_, _, n1, n2, _) -> [ n1; n2 ]
  | Ijumptable (_, l) -> l
  | Itailcall _ | Ireturn _ -> []

let predicted_successor = function
  | Inop n | Iop (_, _, _, n) | Iload (_, _, _, _, _, n) | Istore (_, _, _, _, n)
    ->
      Some n
  | Icall (_, _, _, _, n) | Ibuiltin (_, _, _, n) -> None
  | Icond (_, _, n1, n2, p) -> (
      match p with Some true -> Some n1 | Some false -> Some n2 | None -> None)
  | Ijumptable _ | Itailcall _ | Ireturn _ -> None

let non_predicted_successors i = function
  | None -> successors_inst i
  | Some ps -> List.filter (fun s -> s != ps) (successors_inst i)

(* adapted from Linearizeaux.get_join_points *)
let get_join_points code entry =
  let reached = ref (PTree.map (fun n i -> false) code) in
  let reached_twice = ref (PTree.map (fun n i -> false) code) in
  let rec traverse pc =
    if get_some @@ PTree.get pc !reached then begin
      if not (get_some @@ PTree.get pc !reached_twice) then
        reached_twice := PTree.set pc true !reached_twice
    end else begin
      reached := PTree.set pc true !reached;
      traverse_succs (successors_inst @@ get_some @@ PTree.get pc code)
    end
  and traverse_succs = function
    | [] -> ()
    | [pc] -> traverse pc
    | pc :: l -> traverse pc; traverse_succs l
  in traverse entry; !reached_twice