printer and freg bugfix

1 files changed, 84 insertions, 57 deletions

diff --git a/aarch64/PeepholeOracle.ml b/aarch64/PeepholeOracle.ml
index b97f84b4..83e454e7 100644
--- a/aarch64/PeepholeOracle.ml
+++ b/aarch64/PeepholeOracle.ml
@@ -64,6 +64,7 @@ let is_valid_str64 b1 b2 n1 n2 =
   else false
 
 let dreg_of_ireg r = IR (RR1 r)
+let dreg_of_freg r = FR r
 
 (* Return true if an intermediate
  * affectation eliminates the potential
@@ -85,6 +86,28 @@ let verify_store_affect reg rs b rev =
   let b = IR b in
   dreg_eq reg b || dreg_eq reg rs
 
+type ph_type =
+  | P32
+  | P32f
+  | P64
+  | P64f
+
+type inst_type =
+  | Ldr of ph_type
+  | Str of ph_type
+
+let ph_ty_to_string = function
+  | Ldr P32 -> "ldr32"
+  | Ldr P32f -> "ldr32f"
+  | Ldr P64 -> "ldr64"
+  | Ldr P64f -> "ldr64f"
+  | Str P32 -> "str32"
+  | Str P32f -> "str32f"
+  | Str P64 -> "str64"
+  | Str P64f -> "str64f"
+
+let print_ph_ty chan v = output_string chan (ph_ty_to_string v)
+
 (* Affect a symbolic memory list of potential replacements
  * for a given write in reg *)
 let rec affect_symb_mem reg insta pot_rep stype rev =
@@ -92,11 +115,11 @@ let rec affect_symb_mem reg insta pot_rep stype rev =
   | [] -> []
   | h0 :: t0 -> (
       match (insta.(h0), stype) with
-      | PLoad (PLd_rd_a (_, rd, ADimm (b, n))), "ldr" ->
+      | PLoad (PLd_rd_a (_, rd, ADimm (b, n))), Ldr _ ->
           if verify_load_affect reg rd b rev then
             affect_symb_mem reg insta t0 stype rev
           else h0 :: affect_symb_mem reg insta t0 stype rev
-      | PStore (PSt_rs_a (_, rs, ADimm (b, n))), "str" ->
+      | PStore (PSt_rs_a (_, rs, ADimm (b, n))), Str _ ->
           if verify_store_affect reg rs b rev then
             affect_symb_mem reg insta t0 stype rev
           else h0 :: affect_symb_mem reg insta t0 stype rev
@@ -110,11 +133,11 @@ let rec read_symb_mem reg insta pot_rep stype rev =
   | [] -> []
   | h0 :: t0 -> (
       match (insta.(h0), stype) with
-      | PLoad (PLd_rd_a (_, rd, ADimm (b, n))), "ldr" ->
+      | PLoad (PLd_rd_a (_, rd, ADimm (b, n))), Ldr _ ->
           if verify_load_read reg rd b rev then
             read_symb_mem reg insta t0 stype rev
           else h0 :: read_symb_mem reg insta t0 stype rev
-      | PStore (PSt_rs_a (_, rs, ADimm (b, n))), "str" ->
+      | PStore (PSt_rs_a (_, rs, ADimm (b, n))), Str _ ->
           h0 :: read_symb_mem reg insta t0 stype rev
       | _, _ -> failwith "read_symb_mem: Found an inconsistent inst in pot_rep")
 
@@ -194,7 +217,8 @@ let update_pot_rep_basic inst insta pot_rep stype rev =
           pot_rep := read_symb_mem rs1 insta !pot_rep stype rev
       | Pcset (rd, _) ->
           pot_rep := affect_symb_mem (dreg_of_ireg rd) insta !pot_rep stype rev
-      | Pfmovi (_, _, rs) -> (
+      | Pfmovi (_, rd, rs) -> (
+        pot_rep := affect_symb_mem (dreg_of_freg rd) insta !pot_rep stype rev;
           match rs with
           | RR0 rs ->
               pot_rep :=
@@ -204,12 +228,15 @@ let update_pot_rep_basic inst insta pot_rep stype rev =
           pot_rep := affect_symb_mem rd insta !pot_rep stype rev;
           pot_rep := read_symb_mem rs1 insta !pot_rep stype rev;
           pot_rep := read_symb_mem rs2 insta !pot_rep stype rev
-      | Pfnmul (_, rd, rs1, rs2) -> ())
+      | Pfnmul (_, rd, rs1, rs2) -> 
+          pot_rep := affect_symb_mem (dreg_of_freg rd) insta !pot_rep stype rev;
+          pot_rep := read_symb_mem (dreg_of_freg rs1) insta !pot_rep stype rev;
+          pot_rep := read_symb_mem (dreg_of_freg rs2) insta !pot_rep stype rev)
   | PLoad i -> (
       (* Here, we consider a different behavior for load and store potential candidates:
          * a load does not obviously cancel the ldp candidates, but it does for any stp candidate. *)
       match stype with
-      | "ldr" -> (
+      | Ldr _ -> (
           match i with
           | PLd_rd_a (_, rd, a) ->
               pot_rep := affect_symb_mem rd insta !pot_rep stype rev;
@@ -225,7 +252,7 @@ let update_pot_rep_basic inst insta pot_rep stype rev =
       (* Here, we consider that a store cancel all ldp candidates, but it is far more complicated for stp ones :
          * if we cancel stp candidates here, we would prevent ourselves to apply the non-consec store peephole.
          * To solve this issue, the store candidates cleaning is managed directly in the peephole function below. *)
-      match stype with "ldr" -> pot_rep := [] | _ -> ())
+      match stype with Ldr _ -> pot_rep := [] | _ -> ())
   | Pallocframe (_, _) -> pot_rep := []
   | Pfreeframe (_, _) -> pot_rep := []
   | Ploadsymbol (rd, _) ->
@@ -288,30 +315,30 @@ let are_compat_store (sti1 : store_rs_a) (sti2 : store_rs_a) =
   | Pstrd | Pstrd_a -> ( match sti2 with Pstrd | Pstrd_a -> true | _ -> false)
   | _ -> false
 
-let get_load_string (ldi : load_rd_a) =
+let get_load_pht (ldi : load_rd_a) =
   match ldi with
-  | Pldrw | Pldrw_a -> "ldr32"
-  | Pldrs -> "ldr32f"
-  | Pldrx | Pldrx_a -> "ldr64"
-  | Pldrd | Pldrd_a -> "ldr64f"
+  | Pldrw | Pldrw_a -> Ldr P32
+  | Pldrs -> Ldr P32f
+  | Pldrx | Pldrx_a -> Ldr P64
+  | Pldrd | Pldrd_a -> Ldr P64f
   | _ -> failwith "get_load_string: Found a non compatible load to translate"
 
-let get_store_string (sti : store_rs_a) =
+let get_store_pht (sti : store_rs_a) =
   match sti with
-  | Pstrw | Pstrw_a -> "str32"
-  | Pstrs -> "str32f"
-  | Pstrx | Pstrx_a -> "str64"
-  | Pstrd | Pstrd_a -> "str64f"
+  | Pstrw | Pstrw_a -> Str P32
+  | Pstrs -> Str P32f
+  | Pstrx | Pstrx_a -> Str P64
+  | Pstrd | Pstrd_a -> Str P64f
   | _ -> failwith "get_store_string: Found a non compatible store to translate"
 
 let is_valid_ldr rd1 rd2 b1 b2 n1 n2 stype =
   match stype with
-  | "ldr32" | "ldr32f" -> is_valid_ldr32 rd1 rd2 b1 b2 n1 n2
+  | Ldr P32 | Ldr P32f -> is_valid_ldr32 rd1 rd2 b1 b2 n1 n2
   | _ -> is_valid_ldr64 rd1 rd2 b1 b2 n1 n2
 
 let is_valid_str b1 b2 n1 n2 stype =
   match stype with
-  | "str32" | "str32f" -> is_valid_str32 b1 b2 n1 n2
+  | Str P32 | Str P32f -> is_valid_str32 b1 b2 n1 n2
   | _ -> is_valid_str64 b1 b2 n1 n2
 
 (* Try to find the index of the first previous compatible
@@ -368,14 +395,14 @@ let pair_rep_inv insta =
     let h0 = insta.(i) in
     let h1 = insta.(i - 1) in
     (* Here we need to update every symbolic memory according to the matched inst *)
-    update_pot_rep_basic h0 insta pot_ldrw_rep "ldr" true;
-    update_pot_rep_basic h0 insta pot_ldrx_rep "ldr" true;
-    update_pot_rep_basic h0 insta pot_ldrs_rep "ldr" true;
-    update_pot_rep_basic h0 insta pot_ldrd_rep "ldr" true;
-    update_pot_rep_basic h0 insta pot_strw_rep "str" true;
-    update_pot_rep_basic h0 insta pot_strx_rep "str" true;
-    update_pot_rep_basic h0 insta pot_strs_rep "str" true;
-    update_pot_rep_basic h0 insta pot_strd_rep "str" true;
+    update_pot_rep_basic h0 insta pot_ldrw_rep (Ldr P32) true;
+    update_pot_rep_basic h0 insta pot_ldrx_rep (Ldr P64) true;
+    update_pot_rep_basic h0 insta pot_ldrs_rep (Ldr P32f) true;
+    update_pot_rep_basic h0 insta pot_ldrd_rep (Ldr P64f) true;
+    update_pot_rep_basic h0 insta pot_strw_rep (Str P32) true;
+    update_pot_rep_basic h0 insta pot_strx_rep (Str P64) true;
+    update_pot_rep_basic h0 insta pot_strs_rep (Str P32f) true;
+    update_pot_rep_basic h0 insta pot_strd_rep (Str P64f) true;
     match (h0, h1) with
     (* Non-consecutive ldr *)
     | PLoad (PLd_rd_a (ldi, rd1, ADimm (b1, n1))), _ -> (
@@ -388,9 +415,9 @@ let pair_rep_inv insta =
             | _ -> pot_ldrd_rep
           in
           (* Search a previous compatible load *)
-          let ld_string = get_load_string ldi in
+          let ld_t = get_load_pht ldi in
           match
-            search_compat_rep_inv rd1 b1 n1 insta !pot_rep ld_string
+            search_compat_rep_inv rd1 b1 n1 insta !pot_rep ld_t
           with
           (* If we can't find a candidate, add the current load as a potential future one *)
           | None -> pot_rep := i :: !pot_rep
@@ -401,13 +428,13 @@ let pair_rep_inv insta =
               pot_rep := List.filter filt !pot_rep;
               insta.(rep) <- Pnop;
               if min_is_rev n n1 then (
-                if debug then eprintf "LDP_BACK_SPACED_PEEP_IMM_INC_%s\n" ld_string;
+                if debug then eprintf "LDP_BACK_SPACED_PEEP_IMM_INC_%a\n" print_ph_ty ld_t;
                 insta.(i) <-
                   PLoad
                     (Pldp
                        (trans_ldi ldi, r, rd1, c, chunk_load ldi, ADimm (b, n))))
               else (
-                if debug then eprintf "LDP_BACK_SPACED_PEEP_IMM_DEC_%s\n" ld_string;
+                if debug then eprintf "LDP_BACK_SPACED_PEEP_IMM_DEC_%a\n" print_ph_ty ld_t;
                 insta.(i) <-
                   PLoad
                     (Pldp
@@ -424,9 +451,9 @@ let pair_rep_inv insta =
             | _ -> pot_strd_rep
           in
           (* Search a previous compatible store *)
-          let st_string = get_store_string sti in
+          let st_t = get_store_pht sti in
           match
-            search_compat_rep_inv rd1 b1 n1 insta !pot_rep st_string
+            search_compat_rep_inv rd1 b1 n1 insta !pot_rep st_t
           with
           (* If we can't find a candidate, clean and add the current store as a potential future one *)
           | None ->
@@ -441,7 +468,7 @@ let pair_rep_inv insta =
               let filt x = x != rep in
               pot_rep := List.filter filt !pot_rep;
               insta.(rep) <- Pnop;
-              if debug then eprintf "STP_BACK_SPACED_PEEP_IMM_INC_%s\n" st_string;
+              if debug then eprintf "STP_BACK_SPACED_PEEP_IMM_INC_%a\n" print_ph_ty st_t;
               insta.(i) <-
                 PStore
                   (Pstp
@@ -475,23 +502,23 @@ let pair_rep insta =
     let h0 = insta.(i) in
     let h1 = insta.(i + 1) in
     (* Here we need to update every symbolic memory according to the matched inst *)
-    update_pot_rep_basic h0 insta pot_ldrw_rep "ldr" false;
-    update_pot_rep_basic h0 insta pot_ldrx_rep "ldr" false;
-    update_pot_rep_basic h0 insta pot_ldrs_rep "ldr" false;
-    update_pot_rep_basic h0 insta pot_ldrd_rep "ldr" false;
-    update_pot_rep_basic h0 insta pot_strw_rep "str" false;
-    update_pot_rep_basic h0 insta pot_strx_rep "str" false;
-    update_pot_rep_basic h0 insta pot_strs_rep "str" false;
-    update_pot_rep_basic h0 insta pot_strd_rep "str" false;
+    update_pot_rep_basic h0 insta pot_ldrw_rep (Ldr P32) true;
+    update_pot_rep_basic h0 insta pot_ldrx_rep (Ldr P64) true;
+    update_pot_rep_basic h0 insta pot_ldrs_rep (Ldr P32f) true;
+    update_pot_rep_basic h0 insta pot_ldrd_rep (Ldr P64f) true;
+    update_pot_rep_basic h0 insta pot_strw_rep (Str P32) true;
+    update_pot_rep_basic h0 insta pot_strx_rep (Str P64) true;
+    update_pot_rep_basic h0 insta pot_strs_rep (Str P32f) true;
+    update_pot_rep_basic h0 insta pot_strd_rep (Str P64f) true;
     match (h0, h1) with
     (* Consecutive ldr *)
     | ( PLoad (PLd_rd_a (ldi1, rd1, ADimm (b1, n1))),
         PLoad (PLd_rd_a (ldi2, rd2, ADimm (b2, n2))) ) ->
         if are_compat_load ldi1 ldi2 then
-          let ld_string = get_load_string ldi1 in
-          if is_valid_ldr rd1 rd2 b1 b2 n1 n2 ld_string then (
+          let ld_t = get_load_pht ldi1 in
+          if is_valid_ldr rd1 rd2 b1 b2 n1 n2 ld_t then (
             if min_is_rev n1 n2 then (
-              if debug then eprintf "LDP_CONSEC_PEEP_IMM_INC_%s\n" ld_string;
+              if debug then eprintf "LDP_CONSEC_PEEP_IMM_INC_%a\n" print_ph_ty ld_t;
               insta.(i) <-
                 PLoad
                   (Pldp
@@ -502,7 +529,7 @@ let pair_rep insta =
                        chunk_load ldi2,
                        ADimm (b1, n1) )))
             else (
-              if debug then eprintf "LDP_CONSEC_PEEP_IMM_DEC_%s\n" ld_string;
+              if debug then eprintf "LDP_CONSEC_PEEP_IMM_DEC_%a\n" print_ph_ty ld_t;
               insta.(i) <-
                 PLoad
                   (Pldp
@@ -524,9 +551,9 @@ let pair_rep insta =
             | _ -> pot_ldrd_rep
           in
           (* Search a previous compatible load *)
-          let ld_string = get_load_string ldi in
+          let ld_t = get_load_pht ldi in
           match
-            search_compat_rep rd1 b1 n1 insta !pot_rep ld_string
+            search_compat_rep rd1 b1 n1 insta !pot_rep ld_t
           with
           (* If we can't find a candidate, add the current load as a potential future one *)
           | None -> pot_rep := i :: !pot_rep
@@ -537,13 +564,13 @@ let pair_rep insta =
               pot_rep := List.filter filt !pot_rep;
               insta.(rep) <- Pnop;
               if min_is_rev n n1 then (
-                if debug then eprintf "LDP_FORW_SPACED_PEEP_IMM_INC_%s\n" ld_string;
+                if debug then eprintf "LDP_FORW_SPACED_PEEP_IMM_INC_%a\n" print_ph_ty ld_t;
                 insta.(i) <-
                   PLoad
                     (Pldp
                        (trans_ldi ldi, r, rd1, c, chunk_load ldi, ADimm (b, n))))
               else (
-                if debug then eprintf "LDP_FORW_SPACED_PEEP_IMM_DEC_%s\n" ld_string;
+                if debug then eprintf "LDP_FORW_SPACED_PEEP_IMM_DEC_%a\n" print_ph_ty ld_t;
                 insta.(i) <-
                   PLoad
                     (Pldp
@@ -560,9 +587,9 @@ let pair_rep insta =
         pot_strs_rep := [];
         pot_strd_rep := [];
         if are_compat_store sti1 sti2 then
-          let st_string = get_store_string sti1 in
-          if is_valid_str b1 b2 n1 n2 st_string then (
-            if debug then eprintf "STP_CONSEC_PEEP_IMM_INC_%s\n" st_string;
+          let st_t = get_store_pht sti1 in
+          if is_valid_str b1 b2 n1 n2 st_t then (
+            if debug then eprintf "STP_CONSEC_PEEP_IMM_INC_%a\n" print_ph_ty st_t;
             insta.(i) <-
               PStore
                 (Pstp
@@ -584,9 +611,9 @@ let pair_rep insta =
             | _ -> pot_strd_rep
           in
           (* Search a previous compatible store *)
-          let st_string = get_store_string sti in
+          let st_t = get_store_pht sti in
           match
-            search_compat_rep rd1 b1 n1 insta !pot_rep st_string
+            search_compat_rep rd1 b1 n1 insta !pot_rep st_t
           with
           (* If we can't find a candidate, clean and add the current store as a potential future one *)
           | None ->
@@ -601,7 +628,7 @@ let pair_rep insta =
               let filt x = x != rep in
               pot_rep := List.filter filt !pot_rep;
               insta.(rep) <- Pnop;
-              if debug then eprintf "STP_FORW_SPACED_PEEP_IMM_INC_%s\n" st_string;
+              if debug then eprintf "STP_FORW_SPACED_PEEP_IMM_INC_%a\n" print_ph_ty st_t;
               insta.(i) <-
                 PStore
                   (Pstp (trans_sti sti, r, rd1, c, chunk_store sti, ADimm (b, n)))