From 67cfb5b65007aedbcadbdc92d1bc6507c7187858 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Mon, 29 Mar 2021 16:17:31 +0200
Subject: Simplifications on Linearize - details below

While I was developing the new trace linearize, I started off with
implementing a big algorithm reasoning on dependencies etc.., but I
realized later that it was giving a too different performance (sometimes
better, sometimes worst) than the original CompCert. So I
stripped it off gradually until its performance (on regular code with
just branch prediction) was on par with the base Linearize of CompCert.

I was aiming here for something that is either equal, or better, in
terms of performance.

My (then and current) theory is that I have stripped it out so much that
now it's just like the algorithm of CompCert, but with a modification
for Lcond instructions (see the new linearize_aux_cb). However, I never
tested that theory: the code worked, so I left it as is, without any
simplification. But now that I need to get a clear version for my
manuscript, I'm digging into it.

It turns out my theory is not really exact.
A difference is that instead of taking the minpc across the chain, I take
the pc of the very first block of the chain I create. This was (I think)
out of laziness in the middle of two iterations, except that I forgot
about it.

I tested my new theory by deleting all the stuff about dependencies
calculation (commited), and also computing a minpc just like original
compcert (not commited): I get the same exact Mach code than
linearize_aux_cb.

So right now, the only difference between linearize_aux_cb and
linearize_aux_trace is that slightly different minpc computation.

I think transitionning to linearize_aux_cb will be 1) much clearer than
this Frankenstein monster of linearize_aux_trace that I made, and 2)
might be better performing too.

I don't have access to Kalray machines today so i'm leaving this on hold
for now, but tomorrow I will test performance wise to see if there is a
regression. If there isn't, I will commit this (and it will be the
version narrated by my manuscript).

If there is a regression, it would mean selecting the pc of the first
node (in opposition to the minpc) is more performant, so i'd backtrack
the change to linearize_aux_cb anyway and there should then be 0
difference in the generated code.
---
 backend/Linearizeaux.ml | 284 ++++++++++++++----------------------------------
 1 file changed, 79 insertions(+), 205 deletions(-)

(limited to 'backend')

diff --git a/backend/Linearizeaux.ml b/backend/Linearizeaux.ml
index 3f1a8b6e..402e376d 100644
--- a/backend/Linearizeaux.ml
+++ b/backend/Linearizeaux.ml
@@ -128,6 +128,68 @@ let enumerate_aux_flat f reach =
  * heuristic
  *)
 
+let super_blocks f joins =
+  let blocks = ref [] in
+  let visited = ref IntSet.empty in
+  (* start_block:
+       pc is the function entry point
+          or a join point
+          or the successor of a conditional test *)
+  let rec start_block pc =
+    let npc = P.to_int pc in
+    if not (IntSet.mem npc !visited) then begin
+      visited := IntSet.add npc !visited;
+      in_block [] max_int pc
+    end
+  (* in_block: add pc to block and check successors *)
+  and in_block blk minpc pc =
+    let npc = P.to_int pc in
+    let blk = pc :: blk in
+    let minpc = min npc minpc in
+    match PTree.get pc f.fn_code with
+    | None -> assert false
+    | Some b ->
+       let rec do_instr_list = function
+       | [] -> assert false
+       | Lbranch s :: _ -> next_in_block blk minpc s
+       | Ltailcall (sig0, ros) :: _ -> end_block blk minpc
+       | Lcond (cond, args, ifso, ifnot, pred) :: _ -> begin
+            match pred with
+            | None -> (end_block blk minpc; start_block ifso; start_block ifnot)
+            | Some true -> (next_in_block blk minpc ifso; start_block ifnot)
+            | Some false -> (next_in_block blk minpc ifnot; start_block ifso)
+          end
+       | Ljumptable(arg, tbl) :: _ ->
+             end_block blk minpc; List.iter start_block tbl
+       | Lreturn :: _ -> end_block blk minpc
+       | instr :: b' -> do_instr_list b' in
+       do_instr_list b
+  (* next_in_block: check if join point and either extend block
+     or start block *)
+  and next_in_block blk minpc pc =
+    let npc = P.to_int pc in
+    if IntSet.mem npc joins
+    then (end_block blk minpc; start_block pc)
+    else in_block blk minpc pc
+  (* end_block: record block that we just discovered *)
+  and end_block blk minpc =
+    blocks := (minpc, List.rev blk) :: !blocks
+  in
+    start_block f.fn_entrypoint; !blocks
+
+(* Build the enumeration *)
+
+let enumerate_aux_sb f reach =
+  flatten_blocks (super_blocks f (join_points f))
+
+(**
+ * Alternate enumeration based on traces as identified by Duplicate.v 
+ *
+ * This is a slight alteration to the above heuristic, ensuring that any
+ * superblock will be contiguous in memory, while still following the original
+ * heuristic
+ *)
+
 let get_some = function
 | None -> failwith "Did not get some"
 | Some thing -> thing
@@ -207,98 +269,6 @@ let forward_sequences code entry =
       in [fs] @ ((f code rem_from_node) @ (f code ln))
   in (f code [entry])
 
-(** Unused code
-module PInt = struct
-  type t = P.t
-  let compare x y = compare (P.to_int x) (P.to_int y)
-end
-
-module PSet = Set.Make(PInt)
-
-module LPInt = struct
-  type t = P.t list
-  let rec compare x y =
-    match x with
-    | [] -> ( match y with
-      | [] -> 0
-      | _ -> 1 )
-    | e :: l -> match y with
-      | [] -> -1
-      | e' :: l' ->
-          let e_cmp = PInt.compare e e' in
-          if e_cmp == 0 then compare l l' else e_cmp
-end
-
-module LPSet = Set.Make(LPInt)
-
-let iter_lpset f s = Seq.iter f (LPSet.to_seq s)
-
-let first_of = function
-  | [] -> None
-  | e :: l -> Some e
-
-let rec last_of = function
-  | [] -> None
-  | e :: l -> (match l with [] -> Some e | e :: l -> last_of l)
-
-let can_be_merged code s s' =
-  let last_s = get_some @@ last_of s in
-  let first_s' = get_some @@ first_of s' in
-  match get_some @@ PTree.get last_s code with
-  | Lop _ | Lload _ | Lgetstack _ | Lsetstack _ | Lstore _ | Lcall _
-  | Lbuiltin _ | Ltailcall _ | Lreturn -> false
-  | Lbranch n -> n == first_s'
-  | Lcond (_, _, ifso, ifnot, info) -> (match info with
-    | None -> false
-    | Some false -> ifnot == first_s'
-    | Some true -> failwith "Inconsistency detected - ifnot is not the preferred branch")
-  | Ljumptable (_, ln) ->
-      match ln with
-      | [] -> false
-      | n :: ln -> n == first_s'
-
-let merge s s' = Some s
-
-let try_merge code (fs: (BinNums.positive list) list) =
-  let seqs = ref (LPSet.of_list fs) in
-  let oldLength = ref (LPSet.cardinal !seqs) in
-  let continue = ref true in
-  let found = ref false in
-  while !continue do
-    begin
-      found := false;
-      iter_lpset (fun s ->
-        if !found then ()
-        else iter_lpset (fun s' ->
-          if (!found || s == s') then ()
-          else if (can_be_merged code s s') then
-            begin
-              seqs := LPSet.remove s !seqs;
-              seqs := LPSet.remove s' !seqs;
-              seqs := LPSet.add (get_some (merge s s')) !seqs;
-              found := true;
-            end
-          else ()
-        ) !seqs
-      ) !seqs;
-      if !oldLength == LPSet.cardinal !seqs then
-        continue := false
-      else
-        oldLength := LPSet.cardinal !seqs
-    end
-  done;
-  !seqs
-*)
-
-(** Code adapted from Duplicateaux.get_loop_headers
-  *
-  * Getting loop branches with a DFS visit :
-  * Each node is either Unvisited, Visited, or Processed
-  * pre-order: node becomes Processed
-  * post-order: node becomes Visited
-  *
-  * If we come accross an edge to a Processed node, it's a loop!
-  *)
 type pos = BinNums.positive
 
 module PP = struct
@@ -315,38 +285,6 @@ module PPMap = Map.Make(PP)
 
 type vstate = Unvisited | Processed | Visited
 
-let get_loop_edges code entry =
-  let visited = ref (PTree.map (fun n i -> Unvisited) code) in
-  let is_loop_edge = ref PPMap.empty
-  in let rec dfs_visit code from = function
-  | [] -> ()
-  | node :: ln ->
-      match (get_some @@ PTree.get node !visited) with
-      | Visited -> ()
-      | Processed -> begin
-          let from_node = get_some from in
-          is_loop_edge := PPMap.add (from_node, node) true !is_loop_edge;
-          visited := PTree.set node Visited !visited
-        end
-      | Unvisited -> begin
-          visited := PTree.set node Processed !visited;
-          let bb = get_some @@ PTree.get node code in
-          let next_visits = (match (last_element bb) with
-          | Lop _ | Lload _ | Lgetstack _ | Lsetstack _ | Lstore _ | Lcall _
-          | Lbuiltin _ -> assert false
-          | Ltailcall _ | Lreturn -> []
-          | Lbranch n -> [n]
-          | Lcond (_, _, ifso, ifnot, _) -> [ifso; ifnot]
-          | Ljumptable(_, ln) -> ln
-          ) in dfs_visit code (Some node) next_visits;
-          visited := PTree.set node Visited !visited;
-          dfs_visit code from ln
-        end
-  in begin
-    dfs_visit code None [entry];
-    !is_loop_edge
-  end
-
 let ppmap_is_true pp ppmap = PPMap.mem pp ppmap && PPMap.find pp ppmap
 
 module Int = struct
@@ -364,70 +302,6 @@ let print_iset s = begin
   end
 end
 
-let print_depmap dm = begin
-  if !debug_flag then begin
-    Printf.printf "[|";
-    Array.iter (fun s -> print_iset s; Printf.printf ", ") dm;
-    Printf.printf "|]\n"
-  end
-end
-
-let construct_depmap code entry fs =
-  let is_loop_edge = get_loop_edges code entry in
-  let visited = ref (PTree.map (fun n i -> false) code) in
-  let depmap = Array.map (fun e -> ISet.empty) fs in
-  let find_index_of_node n =
-    let index = ref 0 in
-    begin
-      Array.iteri (fun i s ->
-        match List.find_opt (fun e -> e == n) s with
-        | Some _ -> index := i
-        | None -> ()
-      ) fs;
-      !index
-    end
-  in let check_and_update_depmap from target =
-    (* debug "From %d to %d\n" (P.to_int from) (P.to_int target); *)
-    if not (ppmap_is_true (from, target) is_loop_edge) then
-      let in_index_fs = find_index_of_node from in
-      let out_index_fs = find_index_of_node target in
-      if out_index_fs != in_index_fs then
-        depmap.(out_index_fs) <- ISet.add in_index_fs depmap.(out_index_fs)
-      else ()
-    else ()
-  in let rec dfs_visit code = function
-  | [] -> ()
-  | node :: ln ->
-      begin
-        match (get_some @@ PTree.get node !visited) with
-        | true -> ()
-        | false -> begin
-            visited := PTree.set node true !visited;
-            let bb = get_some @@ PTree.get node code in
-            let next_visits =
-              match (last_element bb) with
-              | Ltailcall _ | Lreturn -> []
-              | Lbranch n -> (check_and_update_depmap node n; [n])
-              | Lcond (_, _, ifso, ifnot, _) -> begin
-                  check_and_update_depmap node ifso;
-                  check_and_update_depmap node ifnot;
-                  [ifso; ifnot]
-                end
-              | Ljumptable(_, ln) -> begin
-                  List.iter (fun n -> check_and_update_depmap node n) ln;
-                  ln
-                end
-              (* end of bblocks should not be another value than one of the above *)
-              | _ -> failwith "last_element gave an invalid output"
-            in dfs_visit code next_visits
-          end;
-        dfs_visit code ln
-      end
-  in begin
-    dfs_visit code [entry];
-    depmap
-  end
-
 let print_sequence s =
   if !debug_flag then begin
     Printf.printf "[";
@@ -442,23 +316,26 @@ let print_ssequence ofs =
     Printf.printf "]\n"
   end
 
+let rec minpc_of l =
+  match l with
+  | [] -> None
+  | e::l -> begin
+        let e_score = P.to_int e in
+        let mpc = minpc_of l in 
+        match mpc with
+        | None -> Some e_score
+        | Some e_score' -> if e_score < e_score' then Some e_score else Some e_score'
+      end
+
 let order_sequences code entry fs =
   let fs_a = Array.of_list fs in
-  let depmap = construct_depmap code entry fs_a in
   let fs_evaluated = Array.map (fun e -> false) fs_a in
   let ordered_fs = ref [] in
   let evaluate s_id =
     begin
       assert (not fs_evaluated.(s_id));
       ordered_fs := fs_a.(s_id) :: !ordered_fs;
-      fs_evaluated.(s_id) <- true;
-      (* debug "++++++\n";
-      debug "Scheduling %d\n" s_id;
-      debug "Initial depmap: "; print_depmap depmap; *)
-      Array.iteri (fun i deps ->
-        depmap.(i) <- ISet.remove s_id deps
-      ) depmap;
-      (* debug "Final depmap: "; print_depmap depmap; *)
+      fs_evaluated.(s_id) <- true
     end
   in let choose_best_of candidates =
     let current_best_id = ref None in
@@ -486,24 +363,21 @@ let order_sequences code entry fs =
   in let select_next () =
     let candidates = ref [] in
     begin
-      Array.iteri (fun i deps ->
+      Array.iteri (fun i _ ->
         begin
-          (* debug "Deps of %d: " i; print_iset deps; debug "\n"; *)
-          (* FIXME - if we keep it that way (no dependency check), remove all the unneeded stuff *)
-          if ((* deps == ISet.empty && *) not fs_evaluated.(i)) then
+          if (not fs_evaluated.(i)) then
             candidates := i :: !candidates
         end
-      ) depmap;
+      ) fs_a;
       if not (List.length !candidates > 0) then begin
-        Array.iteri (fun i deps ->
+        Array.iteri (fun i _ ->
           if (not fs_evaluated.(i)) then candidates := i :: !candidates
-        ) depmap;
+        ) fs_a;
       end;
       get_some (choose_best_of !candidates)
     end
   in begin
     debug "-------------------------------\n";
-    debug "depmap: "; print_depmap depmap;
     debug "forward sequences identified: "; print_ssequence fs;
     while List.length !ordered_fs != List.length fs do
       let next_id = select_next () in
-- 
cgit 


From f7365bc7d9b0eabc8fa06cafddad1b17ed01584a Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Tue, 30 Mar 2021 15:14:06 +0200
Subject: Simplification of the Linearize heuristic (same result functionally)

---
 backend/Linearizeaux.ml | 222 ++----------------------------------------------
 1 file changed, 6 insertions(+), 216 deletions(-)

(limited to 'backend')

diff --git a/backend/Linearizeaux.ml b/backend/Linearizeaux.ml
index 402e376d..5914f6a3 100644
--- a/backend/Linearizeaux.ml
+++ b/backend/Linearizeaux.ml
@@ -126,6 +126,10 @@ let enumerate_aux_flat f reach =
  * This is a slight alteration to the above heuristic, ensuring that any
  * superblock will be contiguous in memory, while still following the original
  * heuristic
+ *
+ * Slight change: instead of taking the minimum pc of the superblock, we just take
+ * the pc of the first block.
+ * (experimentally this leads to slightly better performance..)
  *)
 
 let super_blocks f joins =
@@ -139,13 +143,11 @@ let super_blocks f joins =
     let npc = P.to_int pc in
     if not (IntSet.mem npc !visited) then begin
       visited := IntSet.add npc !visited;
-      in_block [] max_int pc
+      in_block [] npc pc
     end
   (* in_block: add pc to block and check successors *)
   and in_block blk minpc pc =
-    let npc = P.to_int pc in
     let blk = pc :: blk in
-    let minpc = min npc minpc in
     match PTree.get pc f.fn_code with
     | None -> assert false
     | Some b ->
@@ -182,218 +184,6 @@ let super_blocks f joins =
 let enumerate_aux_sb f reach =
   flatten_blocks (super_blocks f (join_points f))
 
-(**
- * Alternate enumeration based on traces as identified by Duplicate.v 
- *
- * This is a slight alteration to the above heuristic, ensuring that any
- * superblock will be contiguous in memory, while still following the original
- * heuristic
- *)
-
-let get_some = function
-| None -> failwith "Did not get some"
-| Some thing -> thing
-
-exception EmptyList
-
-let rec last_element = function
-  | [] -> raise EmptyList
-  | e :: [] -> e
-  | e' :: e :: l -> last_element (e::l)
-
-let print_plist l =
-  let rec f = function
-  | [] -> ()
-  | n :: l -> Printf.printf "%d, " (P.to_int n); f l
-  in begin
-    if !debug_flag then begin
-      Printf.printf "[";
-      f l;
-      Printf.printf "]"
-    end
-  end
-
-(* adapted from the above join_points function, but with PTree *)
-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_block @@ 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
-
-let forward_sequences code entry =
-  let visited = ref (PTree.map (fun n i -> false) code) in
-  let join_points = get_join_points code entry in
-  (* returns the list of traversed nodes, and a list of nodes to start traversing next *)
-  let rec traverse_fallthrough code node =
-    (* debug "Traversing %d..\n" (P.to_int node); *)
-    if not (get_some @@ PTree.get node !visited) then begin
-      visited := PTree.set node true !visited;
-      match PTree.get node code with
-      | None -> failwith "No such node"
-      | Some bb ->
-          let ln, rem = match (last_element bb) with
-          | Lop _ | Lload _ | Lgetstack _ | Lsetstack _ | Lstore _ | Lcall _
-          | Lbuiltin _ -> assert false
-          | Ltailcall _ | Lreturn -> begin (* debug "STOP tailcall/return\n"; *) ([], []) end
-          | Lbranch n ->
-              if get_some @@ PTree.get n join_points then ([], [n])
-              else let ln, rem = traverse_fallthrough code n in (ln, rem)
-          | Lcond (_, _, ifso, ifnot, info) -> (match info with
-            | None -> begin (* debug "STOP Lcond None\n"; *) ([], [ifso; ifnot]) end
-            | Some false ->
-                if get_some @@ PTree.get ifnot join_points then ([], [ifso; ifnot])
-                else let ln, rem = traverse_fallthrough code ifnot in (ln, [ifso] @ rem)
-            | Some true ->
-                if get_some @@ PTree.get ifso join_points then ([], [ifso; ifnot])
-                else let ln, rem = traverse_fallthrough code ifso in (ln, [ifnot] @ rem)
-            )
-          | Ljumptable(_, ln) -> begin (* debug "STOP Ljumptable\n"; *) ([], ln) end
-          in ([node] @ ln, rem)
-      end
-    else ([], [])
-  in let rec f code = function
-  | [] -> []
-  | node :: ln ->
-      let fs, rem_from_node = traverse_fallthrough code node
-      in [fs] @ ((f code rem_from_node) @ (f code ln))
-  in (f code [entry])
-
-type pos = BinNums.positive
-
-module PP = struct
-  type t = pos * pos
-  let compare a b =
-    let ax, ay = a in
-    let bx, by = b in
-    let dx = compare ax bx in
-    if (dx == 0) then compare ay by
-    else dx
-end
-
-module PPMap = Map.Make(PP)
-
-type vstate = Unvisited | Processed | Visited
-
-let ppmap_is_true pp ppmap = PPMap.mem pp ppmap && PPMap.find pp ppmap
-
-module Int = struct
-  type t = int
-  let compare x y = compare x y
-end
-
-module ISet = Set.Make(Int)
-
-let print_iset s = begin
-  if !debug_flag then begin
-    Printf.printf "{";
-    ISet.iter (fun e -> Printf.printf "%d, " e) s;
-    Printf.printf "}"
-  end
-end
-
-let print_sequence s =
-  if !debug_flag then begin
-    Printf.printf "[";
-    List.iter (fun n -> Printf.printf "%d, " (P.to_int n)) s;
-    Printf.printf "]\n"
-  end
-
-let print_ssequence ofs =
-  if !debug_flag then begin
-    Printf.printf "[";
-    List.iter (fun s -> print_sequence s) ofs;
-    Printf.printf "]\n"
-  end
-
-let rec minpc_of l =
-  match l with
-  | [] -> None
-  | e::l -> begin
-        let e_score = P.to_int e in
-        let mpc = minpc_of l in 
-        match mpc with
-        | None -> Some e_score
-        | Some e_score' -> if e_score < e_score' then Some e_score else Some e_score'
-      end
-
-let order_sequences code entry fs =
-  let fs_a = Array.of_list fs in
-  let fs_evaluated = Array.map (fun e -> false) fs_a in
-  let ordered_fs = ref [] in
-  let evaluate s_id =
-    begin
-      assert (not fs_evaluated.(s_id));
-      ordered_fs := fs_a.(s_id) :: !ordered_fs;
-      fs_evaluated.(s_id) <- true
-    end
-  in let choose_best_of candidates =
-    let current_best_id = ref None in
-    let current_best_score = ref None in
-    begin
-      List.iter (fun id ->
-        match !current_best_id with
-        | None -> begin
-            current_best_id := Some id;
-            match fs_a.(id) with
-            | [] -> current_best_score := None
-            | n::l -> current_best_score := Some (P.to_int n)
-          end
-        | Some b -> begin
-            match fs_a.(id) with
-            | [] -> ()
-            | n::l -> let nscore = P.to_int n in
-              match !current_best_score with
-              | None -> (current_best_id := Some id; current_best_score := Some nscore)
-              | Some bs -> if nscore > bs then (current_best_id := Some id; current_best_score := Some nscore)
-          end
-      ) candidates;
-      !current_best_id
-    end
-  in let select_next () =
-    let candidates = ref [] in
-    begin
-      Array.iteri (fun i _ ->
-        begin
-          if (not fs_evaluated.(i)) then
-            candidates := i :: !candidates
-        end
-      ) fs_a;
-      if not (List.length !candidates > 0) then begin
-        Array.iteri (fun i _ ->
-          if (not fs_evaluated.(i)) then candidates := i :: !candidates
-        ) fs_a;
-      end;
-      get_some (choose_best_of !candidates)
-    end
-  in begin
-    debug "-------------------------------\n";
-    debug "forward sequences identified: "; print_ssequence fs;
-    while List.length !ordered_fs != List.length fs do
-      let next_id = select_next () in
-      evaluate next_id
-    done;
-    debug "forward sequences ordered: "; print_ssequence (List.rev (!ordered_fs));
-    List.rev (!ordered_fs)
-  end
-
-let enumerate_aux_trace f reach =
-  let code = f.fn_code in
-  let entry = f.fn_entrypoint in
-  let fs = forward_sequences code entry in
-  let ofs = order_sequences code entry fs in
-  List.flatten ofs
-
 let enumerate_aux f reach =
-  if !Clflags.option_ftracelinearize then enumerate_aux_trace f reach
+  if !Clflags.option_ftracelinearize then enumerate_aux_sb f reach
   else enumerate_aux_flat f reach
-- 
cgit 


From fe7a71c232068bc57e7e14935ff443a4a6315dac Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Wed, 31 Mar 2021 11:34:55 +0200
Subject: Big simplification of get_loop_info

Another remnant of trying to devise a complicated algorithm for a
problem that was, in fact, very simple: I just had to check whether the
branch was within the loop body.

I tested it functionally on the benchmarks: only heapsort is changed, in
slightly worst (4-5%), because the old get_loop_info had done a buggy
guess that proved to be lucky for that particular case.

The other benchmarks are unchanged: the predictions stay the exact same.

The get_loop_info could potentially be improved by having a natural loop
detection that extends to outer loops (not just inner loops), though I
expect the performance improvements would be very small.
---
 backend/Duplicateaux.ml | 127 ++++++------------------------------------------
 1 file changed, 16 insertions(+), 111 deletions(-)

(limited to 'backend')

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index b3635527..7504f724 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -270,120 +270,25 @@ let get_inner_loops f code is_loop_header =
     ) (PTree.elements loopmap)
   end
 
-
-(* Returns a PTree of either None or Some b where b determines the node following the loop, for a cb instruction *)
-(* It uses the fact that loops in CompCert are done by a branch (backedge) instruction followed by a cb *)
+(* Returns a PTree of either None or Some b where b determines the node in the loop body, for a cb instruction *)
 let get_loop_info f is_loop_header bfs_order code =
-  debug "GET LOOP INFO\n";
-  debug "==================================\n";
   let loop_info = ref (PTree.map (fun n i -> None) code) in
-  let mark_path n lbody =
-    let cb_info = ref PTree.empty in
-    let visited = ref (PTree.map (fun n i -> false) code) in
-    (* Returns true if there is a path from src to dest (not involving jumptables) *)
-    (* Mark nodes as visited along the way *)
-    let explore src dest =
-      debug "Trying to dive a path from %d to %d\n" (P.to_int src) (P.to_int dest);
-      (* Memoizing the results to avoid exponential blow-up *)
-      let memory = ref PTree.empty in
-      let rec explore_rec src =
-        debug "explore_rec %d vs %d... " (P.to_int src) (P.to_int dest);
-        if (P.to_int src) == (P.to_int dest) then (debug "FOUND\n"; true)
-        else if (get_some @@ PTree.get src !visited) then (debug "VISITED... :( \n"; false)
-        (* if we went out of the innermost loop *)
-        else if (not @@ List.mem src lbody) then (debug "Out of innermost...\n"; false)
-        else begin
-          let inst = get_some @@ PTree.get src code in
-          visited := PTree.set src true !visited;
-          match rtl_successors inst with
-          | [] -> false
-          | [s] -> explore_wrap s
-          | [s1; s2] -> let snapshot_visited = ref !visited in begin
-              debug "\t\tSplit at %d: either %d or %d\n" (P.to_int src) (P.to_int s1) (P.to_int s2);
-              (* Remembering that we tried the ifso node *)
-              cb_info := PTree.set src true !cb_info;
-              match explore_wrap s1 with
-              | true -> (
-                  visited := !snapshot_visited;
-                  match explore_wrap s2 with
-                  | true -> begin
-                      (* Both paths lead to a loop: we cannot predict the CB
-                       * (but the explore still succeeds) *)
-                      cb_info := PTree.remove src !cb_info;
-                      true
-                    end
-                  | false -> true (* nothing to do, the explore succeeded *)
-                )
-              | false -> begin
-                  cb_info := PTree.set src false !cb_info;
-                  match explore_wrap s2 with
-                  | true -> true
-                  | false -> (cb_info := PTree.remove src !cb_info; false)
-                end
-            end
-          | _ -> false
-        end
-      and explore_wrap src = begin
-        match PTree.get src !memory with
-        | Some b -> b
-        | None ->
-            let result = explore_rec src in
-            (memory := PTree.set src result !memory; result)
-      end in explore_wrap src
-    (* Goes forward until a CB is encountered
-     * Returns None if no CB was found, or Some the_cb_node
-     * Marks nodes as visited along the way *)
-    in let rec advance_to_cb src =
-      if (get_some @@ PTree.get src !visited) then None
-      else begin
-        visited := PTree.set src true !visited;
-        match get_some @@ PTree.get src code with
-        | Inop s | Iop (_, _, _, s) | Iload (_,_,_,_,_,s) | Istore (_,_,_,_,s) | Icall (_,_,_,_,s)
-        | Ibuiltin (_,_,_,s) -> advance_to_cb s
-        | Icond _ -> Some src
-        | Ijumptable _ | Itailcall _ | Ireturn _ -> None
-      end
-    in begin
-      debug "Attempting to find natural loop from HEAD %d..\n" (P.to_int n);
-      match advance_to_cb n with
-      | None -> (debug "\tNo CB found\n")
-      | Some s -> ( debug "\tFound a CB! %d\n" (P.to_int s);
-          match get_some @@ PTree.get s !loop_info with
-          | None | Some _ -> begin
-              match get_some @@ PTree.get s code with
-              | Icond (_, _, n1, n2, _) -> (
-                  let b1 = explore n1 n in
-                  let b2 = explore n2 n in
-                  if (b1 && b2) then 
-                    debug "\tBoth paths lead back to the head: NONE\n"
-                  else if (b1 || b2) then begin
-                    if b1 then begin 
-                      debug "\tTrue path leads to the head: TRUE\n"; 
-                      loop_info := PTree.set s (Some true) !loop_info;
-                    end else if b2 then begin
-                      debug "\tFalse path leads to the head: FALSE\n";
-                      loop_info := PTree.set s (Some false) !loop_info
-                    end;
-                    debug "\tSetting other CBs encountered..\n";
-                    List.iter (fun (cb, dir) ->
-                      debug "\t\t%d is %B\n" (P.to_int cb) dir;
-                      loop_info := PTree.set cb (Some dir) !loop_info
-                    ) (PTree.elements !cb_info)
-                  end else
-                    debug "\tNo path leads back to the head: NONE\n"
-                )
-              | _ -> failwith "\tNot an Icond\n"
-            end
-          (* | Some _ -> ( debug "already loop info there\n" ) FIXME - we don't know yet whether a branch to a loop head is a backedge or not *)
-        )
-    end
+  let mark_iloop iloop =
+    List.iter (fun n ->
+      match get_some @@ PTree.get n code with
+      | Icond (_, _, ifso, ifnot, _) ->
+          let b1 = List.mem ifso iloop.body in
+          let b2 = List.mem ifnot iloop.body in
+          if (b1 && b2) then ()
+          else if (b1 || b2) then begin
+            if b1 then loop_info := PTree.set n (Some true) !loop_info
+            else if b2 then loop_info := PTree.set n (Some false) !loop_info
+          end
+      | _ -> ()
+    ) iloop.body
   in let iloops = get_inner_loops f code is_loop_header in
-  begin
-    List.iter (fun il -> mark_path il.head il.body) iloops;
-    (* List.iter mark_path @@ List.filter (fun n -> get_some @@ PTree.get n is_loop_header) bfs_order; *)
-    debug "==================================\n";
-    !loop_info
-  end
+  List.iter mark_iloop iloops;
+  !loop_info
 
 (* Remark - compared to the original Branch Prediction for Free paper, we don't use the store heuristic *)
 let get_directions f code entrypoint = begin
-- 
cgit 


From 6ee3ecb0edc17d61a515054952827c495cc03979 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Fri, 2 Apr 2021 11:41:41 +0200
Subject: Simple backedge detection (modified code from get_loop_headers)

---
 backend/Duplicateaux.ml |  3 +++
 backend/LICMaux.ml      | 40 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+)

(limited to 'backend')

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index 7504f724..625cbdd9 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -928,6 +928,9 @@ let loop_rotate f =
   ((code, entrypoint), revmap)
 
 let static_predict f =
+  debug_flag := true;
+  let _ = LICMaux.get_loop_backedges f.fn_code f.fn_entrypoint in
+  debug_flag := false;
   let entrypoint = f.fn_entrypoint in
   let code = f.fn_code in
   let revmap = make_identity_ptree code in
diff --git a/backend/LICMaux.ml b/backend/LICMaux.ml
index 1f6b8817..96e8e8ae 100644
--- a/backend/LICMaux.ml
+++ b/backend/LICMaux.ml
@@ -80,6 +80,46 @@ let get_loop_headers code entrypoint = begin
   end
 end
 
+let get_loop_backedges code entrypoint = begin
+  debug "get_loop_backedges\n";
+  let visited = ref (PTree.map (fun n i -> Unvisited) code)
+  and loop_backedge = ref (PTree.map (fun n i -> None) code)
+  in let rec dfs_visit code origin = function
+  | [] -> ()
+  | node :: ln ->
+      debug "ENTERING node %d, REM are %a\n" (P.to_int node) print_intlist ln;
+      match (get_some @@ PTree.get node !visited) with
+      | Visited -> begin
+          debug "\tNode %d is already Visited, skipping\n" (P.to_int node);
+          dfs_visit code origin ln
+        end
+      | Processed -> begin
+          debug "Node %d is a loop header\n" (P.to_int node);
+          debug "The backedge is from %d\n" (P.to_int @@ get_some origin);
+          loop_backedge := PTree.set node origin !loop_backedge;
+          visited := PTree.set node Visited !visited;
+          dfs_visit code origin ln
+        end
+      | Unvisited -> begin
+          visited := PTree.set node Processed !visited;
+          debug "Node %d is Processed\n" (P.to_int node);
+          (match PTree.get node code with
+          | None -> failwith "No such node"
+          | Some i -> let next_visits = rtl_successors i in begin
+              debug "About to visit: %a\n" print_intlist next_visits;
+              dfs_visit code (Some node) next_visits
+            end);
+          debug "Node %d is Visited!\n" (P.to_int node);
+          visited := PTree.set node Visited !visited;
+          dfs_visit code origin ln
+        end
+  in begin
+    dfs_visit code None [entrypoint];
+    debug "LOOP BACKEDGES: %a\n" print_ptree_opint !loop_backedge;
+    !loop_backedge
+  end
+end
+
 
 module Dominator =
   struct
-- 
cgit 


From b042bca17696a9cb6e2be7bbdac9f08953fff527 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Fri, 2 Apr 2021 11:44:42 +0200
Subject: get_loop_headers simplification (using the new get_loop_backedges)

---
 backend/LICMaux.ml | 46 +++++++---------------------------------------
 1 file changed, 7 insertions(+), 39 deletions(-)

(limited to 'backend')

diff --git a/backend/LICMaux.ml b/backend/LICMaux.ml
index 96e8e8ae..b88dbc2d 100644
--- a/backend/LICMaux.ml
+++ b/backend/LICMaux.ml
@@ -41,45 +41,6 @@ let rtl_successors = function
   *
   * If we come accross an edge to a Processed node, it's a loop!
   *)
-let get_loop_headers code entrypoint = begin
-  debug "get_loop_headers\n";
-  let visited = ref (PTree.map (fun n i -> Unvisited) code)
-  and is_loop_header = ref (PTree.map (fun n i -> false) code)
-  in let rec dfs_visit code = function
-  | [] -> ()
-  | node :: ln ->
-      debug "ENTERING node %d, REM are %a\n" (P.to_int node) print_intlist ln;
-      match (get_some @@ PTree.get node !visited) with
-      | Visited -> begin
-          debug "\tNode %d is already Visited, skipping\n" (P.to_int node);
-          dfs_visit code ln
-        end
-      | Processed -> begin
-          debug "Node %d is a loop header\n" (P.to_int node);
-          is_loop_header := PTree.set node true !is_loop_header;
-          visited := PTree.set node Visited !visited;
-          dfs_visit code ln
-        end
-      | Unvisited -> begin
-          visited := PTree.set node Processed !visited;
-          debug "Node %d is Processed\n" (P.to_int node);
-          (match PTree.get node code with
-          | None -> failwith "No such node"
-          | Some i -> let next_visits = rtl_successors i in begin
-              debug "About to visit: %a\n" print_intlist next_visits;
-              dfs_visit code next_visits
-            end);
-          debug "Node %d is Visited!\n" (P.to_int node);
-          visited := PTree.set node Visited !visited;
-          dfs_visit code ln
-        end
-  in begin
-    dfs_visit code [entrypoint];
-    debug "LOOP HEADERS: %a\n" print_ptree_bool !is_loop_header;
-    !is_loop_header
-  end
-end
-
 let get_loop_backedges code entrypoint = begin
   debug "get_loop_backedges\n";
   let visited = ref (PTree.map (fun n i -> Unvisited) code)
@@ -120,6 +81,13 @@ let get_loop_backedges code entrypoint = begin
   end
 end
 
+let get_loop_headers code entrypoint =
+  let backedges = get_loop_backedges code entrypoint in
+  PTree.map (fun _ ob ->
+    match ob with
+    | None -> false
+    | Some _ -> true
+  ) backedges
 
 module Dominator =
   struct
-- 
cgit 


From a4720c58a97c08b1f8852376c39f15dd44cd0f34 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Fri, 2 Apr 2021 13:06:02 +0200
Subject: Getting all loop bodies

---
 backend/Duplicateaux.ml | 38 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

(limited to 'backend')

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index 625cbdd9..17beb4d0 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -270,6 +270,39 @@ let get_inner_loops f code is_loop_header =
     ) (PTree.elements loopmap)
   end
 
+let get_loop_bodies code entrypoint =
+  let predecessors = get_predecessors_rtl code in
+  (* Algorithm from Muchnik, Compiler Design & Implementation, Figure 7.21 page 192 *)
+  let natural_loop n m =
+    debug "Natural Loop from %d to %d\n" (P.to_int n) (P.to_int m);
+    let in_body = ref (PTree.map (fun n b -> false) code) in
+    let body = ref [] in
+    let add_to_body n = begin
+      in_body := PTree.set n true !in_body;
+      body := n :: !body
+    end
+    in let rec process_node p =
+      debug "    Processing node %d\n" (P.to_int p);
+      List.iter (fun pred ->
+        debug "        Looking at predecessor of %d: %d\n" (P.to_int p) (P.to_int pred);
+        let is_in_body = get_some @@ PTree.get pred !in_body in
+        if (not @@ is_in_body) then begin
+          debug "        --> adding to body\n";
+          add_to_body pred;
+          process_node pred
+        end
+      ) (get_some @@ PTree.get p predecessors)
+    in begin
+      add_to_body m;
+      add_to_body n;
+      (if (m != n) then process_node m);
+      !body
+    end
+  in let option_natural_loop n = function
+    | None -> None
+    | Some m -> Some (natural_loop n m)
+  in PTree.map option_natural_loop (LICMaux.get_loop_backedges code entrypoint)
+
 (* Returns a PTree of either None or Some b where b determines the node in the loop body, for a cb instruction *)
 let get_loop_info f is_loop_header bfs_order code =
   let loop_info = ref (PTree.map (fun n i -> None) code) in
@@ -298,6 +331,7 @@ let get_directions f code entrypoint = begin
   let loop_info = get_loop_info f is_loop_header bfs_order code in
   let directions = ref (PTree.map (fun n i -> None) code) in (* None <=> no predicted direction *)
   begin
+    debug_flag := true;
     (* ptree_printbool is_loop_header; *)
     (* debug "\n"; *)
     List.iter (fun n ->
@@ -325,7 +359,7 @@ let get_directions f code entrypoint = begin
           end
           )
       | _ -> ()
-    ) bfs_order;
+    ) bfs_order; debug_flag := false;
     !directions
   end
 end
@@ -929,7 +963,7 @@ let loop_rotate f =
 
 let static_predict f =
   debug_flag := true;
-  let _ = LICMaux.get_loop_backedges f.fn_code f.fn_entrypoint in
+  Printf.printf "Loop bodies: %a" print_ptree_oplist (get_loop_bodies f.fn_code f.fn_entrypoint);
   debug_flag := false;
   let entrypoint = f.fn_entrypoint in
   let code = f.fn_code in
-- 
cgit 


From 6d4dc7ae91e4452332e6f513733135fefd6f7f26 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Fri, 2 Apr 2021 13:14:36 +0200
Subject: Outermost loop detection works

---
 backend/Duplicateaux.ml | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

(limited to 'backend')

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index 17beb4d0..e864a370 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -306,21 +306,25 @@ let get_loop_bodies code entrypoint =
 (* Returns a PTree of either None or Some b where b determines the node in the loop body, for a cb instruction *)
 let get_loop_info f is_loop_header bfs_order code =
   let loop_info = ref (PTree.map (fun n i -> None) code) in
-  let mark_iloop iloop =
+  let mark_body body =
     List.iter (fun n ->
       match get_some @@ PTree.get n code with
       | Icond (_, _, ifso, ifnot, _) ->
-          let b1 = List.mem ifso iloop.body in
-          let b2 = List.mem ifnot iloop.body in
+          let b1 = List.mem ifso body in
+          let b2 = List.mem ifnot body in
           if (b1 && b2) then ()
           else if (b1 || b2) then begin
             if b1 then loop_info := PTree.set n (Some true) !loop_info
             else if b2 then loop_info := PTree.set n (Some false) !loop_info
           end
       | _ -> ()
-    ) iloop.body
-  in let iloops = get_inner_loops f code is_loop_header in
-  List.iter mark_iloop iloops;
+    ) body
+  in let bodymap = get_loop_bodies code f.fn_entrypoint in
+  List.iter (fun (_,obody) ->
+    match obody with
+    | None -> ()
+    | Some body -> mark_body body
+    ) (PTree.elements bodymap);
   !loop_info
 
 (* Remark - compared to the original Branch Prediction for Free paper, we don't use the store heuristic *)
@@ -962,9 +966,6 @@ let loop_rotate f =
   ((code, entrypoint), revmap)
 
 let static_predict f =
-  debug_flag := true;
-  Printf.printf "Loop bodies: %a" print_ptree_oplist (get_loop_bodies f.fn_code f.fn_entrypoint);
-  debug_flag := false;
   let entrypoint = f.fn_entrypoint in
   let code = f.fn_code in
   let revmap = make_identity_ptree code in
-- 
cgit 


From b6b7b6a525e4b0b9fd727ef9d52c1901c3308cf0 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Fri, 2 Apr 2021 13:16:12 +0200
Subject: More efficient

---
 backend/Duplicateaux.ml | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

(limited to 'backend')

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index e864a370..4d6e7f3a 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -309,14 +309,18 @@ let get_loop_info f is_loop_header bfs_order code =
   let mark_body body =
     List.iter (fun n ->
       match get_some @@ PTree.get n code with
-      | Icond (_, _, ifso, ifnot, _) ->
-          let b1 = List.mem ifso body in
-          let b2 = List.mem ifnot body in
-          if (b1 && b2) then ()
-          else if (b1 || b2) then begin
-            if b1 then loop_info := PTree.set n (Some true) !loop_info
-            else if b2 then loop_info := PTree.set n (Some false) !loop_info
-          end
+      | Icond (_, _, ifso, ifnot, _) -> begin
+          match PTree.get n !loop_info with
+          | None -> ()
+          | Some _ ->
+              let b1 = List.mem ifso body in
+              let b2 = List.mem ifnot body in
+              if (b1 && b2) then ()
+              else if (b1 || b2) then begin
+                if b1 then loop_info := PTree.set n (Some true) !loop_info
+                else if b2 then loop_info := PTree.set n (Some false) !loop_info
+              end
+        end
       | _ -> ()
     ) body
   in let bodymap = get_loop_bodies code f.fn_entrypoint in
-- 
cgit 


From 294df98be0c67f858355ff1ba08e9ac7a03c4ee2 Mon Sep 17 00:00:00 2001
From: Cyril SIX <cyril.six@kalray.eu>
Date: Fri, 2 Apr 2021 13:42:46 +0200
Subject: Cleaning

---
 backend/Duplicateaux.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

(limited to 'backend')

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index 4d6e7f3a..db150521 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -339,7 +339,6 @@ let get_directions f code entrypoint = begin
   let loop_info = get_loop_info f is_loop_header bfs_order code in
   let directions = ref (PTree.map (fun n i -> None) code) in (* None <=> no predicted direction *)
   begin
-    debug_flag := true;
     (* ptree_printbool is_loop_header; *)
     (* debug "\n"; *)
     List.iter (fun n ->
@@ -367,7 +366,7 @@ let get_directions f code entrypoint = begin
           end
           )
       | _ -> ()
-    ) bfs_order; debug_flag := false;
+    ) bfs_order;
     !directions
   end
 end
-- 
cgit