From 63ddeebc8b5a4e8fe1748cf859085c683aefe404 Mon Sep 17 00:00:00 2001
From: Léo Gourdin <leo.gourdin@univ-grenoble-alpes.fr>
Date: Fri, 26 Mar 2021 12:52:26 +0100
Subject: Compiler options to manage expansions

---
 riscV/ExpansionOracle.ml | 351 +++++++++++++++++++++++------------------------
 1 file changed, 174 insertions(+), 177 deletions(-)

(limited to 'riscV')

diff --git a/riscV/ExpansionOracle.ml b/riscV/ExpansionOracle.ml
index 676b8da6..a5fa4a0a 100644
--- a/riscV/ExpansionOracle.ml
+++ b/riscV/ExpansionOracle.ml
@@ -163,14 +163,14 @@ let opimm64 a1 dest n succ k op opimm map_consts =
       let ht = load_hilo64 r hi lo (n2pi ()) map_consts true in
       let r' = unzip_head_tuple ht r in
       build_full_ilist op [ a1; r' ] dest succ (fst ht) k map_consts
-  | Imm64_large imm ->(
+  | Imm64_large imm ->
       let r = r2pi () in
       let op1 = OEloadli imm in
       let inode = n2pi () in
       let sv = find_or_addnmove op1 [] r inode map_consts true in
       let ht = build_head_tuple [] sv in
       let r' = unzip_head_tuple ht r in
-      build_full_ilist op [ a1; r' ] dest succ (fst ht) k map_consts)
+      build_full_ilist op [ a1; r' ] dest succ (fst ht) k map_consts
 
 let addimm32 a1 dest n succ k map_consts =
   opimm32 a1 dest n succ k Oadd Addiw map_consts
@@ -671,13 +671,15 @@ let expanse (sb : superblock) code pm =
            was_branch := true;
            was_exp := true
        | _ -> ());
-      (if !Clflags.option_fexpanse_fpconst && not !was_exp then
+      (if !Clflags.option_fexpanse_others && not !was_exp then
        match inst with
        (* Expansion of fp constants *)
        | Iop (Ofloatconst f, nil, dest, succ) ->
            debug "Iop/Ofloatconst\n";
            let r = r2pi () in
-           let ht = loadimm64 r (Floats.Float.to_bits f) (n2pi ()) map_consts true in
+           let ht =
+             loadimm64 r (Floats.Float.to_bits f) (n2pi ()) map_consts true
+           in
            let r' = unzip_head_tuple ht r in
            exp :=
              build_full_ilist Ofloat_of_bits [ r' ] dest succ (fst ht) []
@@ -694,180 +696,175 @@ let expanse (sb : superblock) code pm =
              build_full_ilist Osingle_of_bits [ r' ] dest succ (fst ht) []
                map_consts;
            was_exp := true
+       | Iop (Ointconst n, nil, dest, succ) ->
+           debug "Iop/Ointconst\n";
+           let ht = loadimm32 dest n succ map_consts false in
+           exp := unzip_head_tuple_move ht dest succ;
+           was_exp := true
+       | Iop (Olongconst n, nil, dest, succ) ->
+           debug "Iop/Olongconst\n";
+           let ht = loadimm64 dest n succ map_consts false in
+           exp := unzip_head_tuple_move ht dest succ;
+           was_exp := true
+       | Iop (Oaddimm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oaddimm\n";
+           exp := addimm32 a1 dest n succ [] map_consts;
+           was_exp := true
+       | Iop (Oaddlimm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oaddlimm\n";
+           exp := addimm64 a1 dest n succ [] map_consts;
+           was_exp := true
+       | Iop (Oandimm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oandimm\n";
+           exp := andimm32 a1 dest n succ [] map_consts;
+           was_exp := true
+       | Iop (Oandlimm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oandlimm\n";
+           exp := andimm64 a1 dest n succ [] map_consts;
+           was_exp := true
+       | Iop (Oorimm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oorimm\n";
+           exp := orimm32 a1 dest n succ [] map_consts;
+           was_exp := true
+       | Iop (Oorlimm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oorlimm\n";
+           exp := orimm64 a1 dest n succ [] map_consts;
+           was_exp := true
+       | Iop (Ocast8signed, a1 :: nil, dest, succ) ->
+           debug "Iop/cast8signed";
+           let op = Oshlimm (Int.repr (Z.of_sint 24)) in
+           let r = r2pi () in
+           let sv = find_or_addnmove op [ a1 ] r (n2pi ()) map_consts true in
+           let ht = build_head_tuple [] sv in
+           let r' = unzip_head_tuple ht r in
+           exp :=
+             build_full_ilist
+               (Oshrimm (Int.repr (Z.of_sint 24)))
+               [ r' ] dest succ (fst ht) [] map_consts;
+           was_exp := true
+       | Iop (Ocast16signed, a1 :: nil, dest, succ) ->
+           debug "Iop/cast8signed";
+           let op = Oshlimm (Int.repr (Z.of_sint 16)) in
+           let r = r2pi () in
+           let sv = find_or_addnmove op [ a1 ] r (n2pi ()) map_consts true in
+           let ht = build_head_tuple [] sv in
+           let r' = unzip_head_tuple ht r in
+           exp :=
+             build_full_ilist
+               (Oshrimm (Int.repr (Z.of_sint 16)))
+               [ r' ] dest succ (fst ht) [] map_consts;
+           was_exp := true
+       | Iop (Ocast32unsigned, a1 :: nil, dest, succ) ->
+           debug "Iop/Ocast32unsigned";
+           let n2 = n2pi () in
+           let n1 = n2pi () in
+           let r1 = r2pi () in
+           let r2 = r2pi () in
+           let op1 = Ocast32signed in
+           let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
+           let ht1 = build_head_tuple [] sv1 in
+           let r1' = unzip_head_tuple ht1 r1 in
+
+           let op2 = Oshllimm (Int.repr (Z.of_sint 32)) in
+           let sv2 = find_or_addnmove op2 [ r1' ] r2 n2 map_consts true in
+           let ht2 = build_head_tuple (fst ht1) sv2 in
+           let r2' = unzip_head_tuple ht2 r2 in
+
+           let op3 = Oshrluimm (Int.repr (Z.of_sint 32)) in
+           exp := build_full_ilist op3 [ r2' ] dest succ (fst ht2) [] map_consts
+       | Iop (Oshrximm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oshrximm";
+           if Int.eq n Int.zero then exp := [ Iop (Omove, [ a1 ], dest, succ) ]
+           else if Int.eq n Int.one then
+             let n2 = n2pi () in
+             let n1 = n2pi () in
+             let r1 = r2pi () in
+             let r2 = r2pi () in
+             let op1 = Oshruimm (Int.repr (Z.of_sint 31)) in
+             let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
+             let ht1 = build_head_tuple [] sv1 in
+             let r1' = unzip_head_tuple ht1 r1 in
+
+             let op2 = Oadd in
+             let sv2 = find_or_addnmove op2 [ a1; r1' ] r2 n2 map_consts true in
+             let ht2 = build_head_tuple (fst ht1) sv2 in
+             let r2' = unzip_head_tuple ht2 r2 in
+
+             let op3 = Oshrimm Int.one in
+             exp :=
+               build_full_ilist op3 [ r2' ] dest succ (fst ht2) [] map_consts
+           else
+             let n3 = n2pi () in
+             let n2 = n2pi () in
+             let n1 = n2pi () in
+             let r1 = r2pi () in
+             let r2 = r2pi () in
+             let r3 = r2pi () in
+             let op1 = Oshrimm (Int.repr (Z.of_sint 31)) in
+             let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
+             let ht1 = build_head_tuple [] sv1 in
+             let r1' = unzip_head_tuple ht1 r1 in
+
+             let op2 = Oshruimm (Int.sub Int.iwordsize n) in
+             let sv2 = find_or_addnmove op2 [ r1' ] r2 n2 map_consts true in
+             let ht2 = build_head_tuple (fst ht1) sv2 in
+             let r2' = unzip_head_tuple ht2 r2 in
+
+             let op3 = Oadd in
+             let sv3 = find_or_addnmove op3 [ a1; r2' ] r3 n3 map_consts true in
+             let ht3 = build_head_tuple (fst ht2) sv3 in
+             let r3' = unzip_head_tuple ht3 r3 in
+
+             let op4 = Oshrimm n in
+             exp :=
+               build_full_ilist op4 [ r3' ] dest succ (fst ht3) [] map_consts
+       | Iop (Oshrxlimm n, a1 :: nil, dest, succ) ->
+           debug "Iop/Oshrxlimm";
+           if Int.eq n Int.zero then exp := [ Iop (Omove, [ a1 ], dest, succ) ]
+           else if Int.eq n Int.one then
+             let n2 = n2pi () in
+             let n1 = n2pi () in
+             let r1 = r2pi () in
+             let r2 = r2pi () in
+             let op1 = Oshrluimm (Int.repr (Z.of_sint 63)) in
+             let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
+             let ht1 = build_head_tuple [] sv1 in
+             let r1' = unzip_head_tuple ht1 r1 in
+
+             let op2 = Oaddl in
+             let sv2 = find_or_addnmove op2 [ a1; r1' ] r2 n2 map_consts true in
+             let ht2 = build_head_tuple (fst ht1) sv2 in
+             let r2' = unzip_head_tuple ht2 r2 in
+
+             let op3 = Oshrlimm Int.one in
+             exp :=
+               build_full_ilist op3 [ r2' ] dest succ (fst ht2) [] map_consts
+           else
+             let n3 = n2pi () in
+             let n2 = n2pi () in
+             let n1 = n2pi () in
+             let r1 = r2pi () in
+             let r2 = r2pi () in
+             let r3 = r2pi () in
+             let op1 = Oshrlimm (Int.repr (Z.of_sint 63)) in
+             let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
+             let ht1 = build_head_tuple [] sv1 in
+             let r1' = unzip_head_tuple ht1 r1 in
+
+             let op2 = Oshrluimm (Int.sub Int64.iwordsize' n) in
+             let sv2 = find_or_addnmove op2 [ r1' ] r2 n2 map_consts true in
+             let ht2 = build_head_tuple (fst ht1) sv2 in
+             let r2' = unzip_head_tuple ht2 r2 in
+
+             let op3 = Oaddl in
+             let sv3 = find_or_addnmove op3 [ a1; r2' ] r3 n3 map_consts true in
+             let ht3 = build_head_tuple (fst ht2) sv3 in
+             let r3' = unzip_head_tuple ht3 r3 in
+
+             let op4 = Oshrlimm n in
+             exp :=
+               build_full_ilist op4 [ r3' ] dest succ (fst ht3) [] map_consts
        | _ -> ());
-
-      (* TODO gourdinl flag ? *)
-      (match inst with
-      | Iop (Ointconst n, nil, dest, succ) ->
-          debug "Iop/Ointconst\n";
-          let ht = loadimm32 dest n succ map_consts false in
-          exp := unzip_head_tuple_move ht dest succ;
-          was_exp := true
-      | Iop (Olongconst n, nil, dest, succ) ->
-          debug "Iop/Olongconst\n";
-          let ht = loadimm64 dest n succ map_consts false in
-          exp := unzip_head_tuple_move ht dest succ;
-          was_exp := true
-      | Iop (Oaddimm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oaddimm\n";
-          exp := addimm32 a1 dest n succ [] map_consts;
-          was_exp := true
-      | Iop (Oaddlimm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oaddlimm\n";
-          exp := addimm64 a1 dest n succ [] map_consts;
-          was_exp := true
-      | Iop (Oandimm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oandimm\n";
-          exp := andimm32 a1 dest n succ [] map_consts;
-          was_exp := true
-      | Iop (Oandlimm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oandlimm\n";
-          exp := andimm64 a1 dest n succ [] map_consts;
-          was_exp := true
-      | Iop (Oorimm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oorimm\n";
-          exp := orimm32 a1 dest n succ [] map_consts;
-          was_exp := true
-      | Iop (Oorlimm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oorlimm\n";
-          exp := orimm64 a1 dest n succ [] map_consts;
-          was_exp := true
-      | Iop (Ocast8signed, a1 :: nil, dest, succ) ->
-          debug "Iop/cast8signed";
-          let op = Oshlimm (Int.repr (Z.of_sint 24)) in
-          let r = r2pi () in
-          let sv = find_or_addnmove op [ a1 ] r (n2pi ()) map_consts true in
-          let ht = build_head_tuple [] sv in
-          let r' = unzip_head_tuple ht r in
-          exp :=
-            build_full_ilist
-              (Oshrimm (Int.repr (Z.of_sint 24)))
-              [ r' ] dest succ (fst ht) [] map_consts;
-          was_exp := true
-      | Iop (Ocast16signed, a1 :: nil, dest, succ) ->
-          debug "Iop/cast8signed";
-          let op = Oshlimm (Int.repr (Z.of_sint 16)) in
-          let r = r2pi () in
-          let sv = find_or_addnmove op [ a1 ] r (n2pi ()) map_consts true in
-          let ht = build_head_tuple [] sv in
-          let r' = unzip_head_tuple ht r in
-          exp :=
-            build_full_ilist
-              (Oshrimm (Int.repr (Z.of_sint 16)))
-              [ r' ] dest succ (fst ht) [] map_consts;
-          was_exp := true
-      | Iop (Ocast32unsigned, a1 :: nil, dest, succ) ->
-          debug "Iop/Ocast32unsigned";
-          let n2 = n2pi () in
-          let n1 = n2pi () in
-          let r1 = r2pi () in
-          let r2 = r2pi () in
-          let op1 = Ocast32signed in
-          let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
-          let ht1 = build_head_tuple [] sv1 in
-          let r1' = unzip_head_tuple ht1 r1 in
-
-          let op2 = Oshllimm (Int.repr (Z.of_sint 32)) in
-          let sv2 = find_or_addnmove op2 [ r1' ] r2 n2 map_consts true in
-          let ht2 = build_head_tuple (fst ht1) sv2 in
-          let r2' = unzip_head_tuple ht2 r2 in
-
-          let op3 = Oshrluimm (Int.repr (Z.of_sint 32)) in
-          exp := build_full_ilist op3 [ r2' ] dest succ (fst ht2) [] map_consts
-      | Iop (Oshrximm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oshrximm";
-          if Int.eq n Int.zero then exp := [ Iop (Omove, [ a1 ], dest, succ) ]
-          else if Int.eq n Int.one then
-            let n2 = n2pi () in
-            let n1 = n2pi () in
-            let r1 = r2pi () in
-            let r2 = r2pi () in
-            let op1 = Oshruimm (Int.repr (Z.of_sint 31)) in
-            let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
-            let ht1 = build_head_tuple [] sv1 in
-            let r1' = unzip_head_tuple ht1 r1 in
-
-            let op2 = Oadd in
-            let sv2 = find_or_addnmove op2 [ a1; r1' ] r2 n2 map_consts true in
-            let ht2 = build_head_tuple (fst ht1) sv2 in
-            let r2' = unzip_head_tuple ht2 r2 in
-
-            let op3 = Oshrimm Int.one in
-            exp :=
-              build_full_ilist op3 [ r2' ] dest succ (fst ht2) [] map_consts
-          else
-            let n3 = n2pi () in
-            let n2 = n2pi () in
-            let n1 = n2pi () in
-            let r1 = r2pi () in
-            let r2 = r2pi () in
-            let r3 = r2pi () in
-            let op1 = Oshrimm (Int.repr (Z.of_sint 31)) in
-            let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
-            let ht1 = build_head_tuple [] sv1 in
-            let r1' = unzip_head_tuple ht1 r1 in
-
-            let op2 = Oshruimm (Int.sub Int.iwordsize n) in
-            let sv2 = find_or_addnmove op2 [ r1' ] r2 n2 map_consts true in
-            let ht2 = build_head_tuple (fst ht1) sv2 in
-            let r2' = unzip_head_tuple ht2 r2 in
-
-            let op3 = Oadd in
-            let sv3 = find_or_addnmove op3 [ a1; r2' ] r3 n3 map_consts true in
-            let ht3 = build_head_tuple (fst ht2) sv3 in
-            let r3' = unzip_head_tuple ht3 r3 in
-
-            let op4 = Oshrimm n in
-            exp :=
-              build_full_ilist op4 [ r3' ] dest succ (fst ht3) [] map_consts
-      | Iop (Oshrxlimm n, a1 :: nil, dest, succ) ->
-          debug "Iop/Oshrxlimm";
-          if Int.eq n Int.zero then exp := [ Iop (Omove, [ a1 ], dest, succ) ]
-          else if Int.eq n Int.one then
-            let n2 = n2pi () in
-            let n1 = n2pi () in
-            let r1 = r2pi () in
-            let r2 = r2pi () in
-            let op1 = Oshrluimm (Int.repr (Z.of_sint 63)) in
-            let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
-            let ht1 = build_head_tuple [] sv1 in
-            let r1' = unzip_head_tuple ht1 r1 in
-
-            let op2 = Oaddl in
-            let sv2 = find_or_addnmove op2 [ a1; r1' ] r2 n2 map_consts true in
-            let ht2 = build_head_tuple (fst ht1) sv2 in
-            let r2' = unzip_head_tuple ht2 r2 in
-
-            let op3 = Oshrlimm Int.one in
-            exp :=
-              build_full_ilist op3 [ r2' ] dest succ (fst ht2) [] map_consts
-          else
-            let n3 = n2pi () in
-            let n2 = n2pi () in
-            let n1 = n2pi () in
-            let r1 = r2pi () in
-            let r2 = r2pi () in
-            let r3 = r2pi () in
-            let op1 = Oshrlimm (Int.repr (Z.of_sint 63)) in
-            let sv1 = find_or_addnmove op1 [ a1 ] r1 n1 map_consts true in
-            let ht1 = build_head_tuple [] sv1 in
-            let r1' = unzip_head_tuple ht1 r1 in
-
-            let op2 = Oshrluimm (Int.sub Int64.iwordsize' n) in
-            let sv2 = find_or_addnmove op2 [ r1' ] r2 n2 map_consts true in
-            let ht2 = build_head_tuple (fst ht1) sv2 in
-            let r2' = unzip_head_tuple ht2 r2 in
-
-            let op3 = Oaddl in
-            let sv3 = find_or_addnmove op3 [ a1; r2' ] r3 n3 map_consts true in
-            let ht3 = build_head_tuple (fst ht2) sv3 in
-            let r3' = unzip_head_tuple ht3 r3 in
-
-            let op4 = Oshrlimm n in
-            exp :=
-              build_full_ilist op4 [ r3' ] dest succ (fst ht3) [] map_consts
-      | _ -> ());
-
       if !was_exp then (
         (if !was_branch && List.length !exp > 1 then
          let lives = PTree.get n !liveins in
-- 
cgit