aboutsummaryrefslogtreecommitdiffstats
path: root/riscV
diff options
context:
space:
mode:
authorLéo Gourdin <leo.gourdin@univ-grenoble-alpes.fr>2021-03-26 12:52:26 +0100
committerLéo Gourdin <leo.gourdin@univ-grenoble-alpes.fr>2021-03-26 12:52:26 +0100
commit63ddeebc8b5a4e8fe1748cf859085c683aefe404 (patch)
tree40b4832a1c0b166952f04abc034e72863c5488a7 /riscV
parent95205e72ca536907fa89c7c884f0e22fc605063d (diff)
downloadcompcert-kvx-63ddeebc8b5a4e8fe1748cf859085c683aefe404.tar.gz
compcert-kvx-63ddeebc8b5a4e8fe1748cf859085c683aefe404.zip
Compiler options to manage expansions
Diffstat (limited to 'riscV')
-rw-r--r--riscV/ExpansionOracle.ml351
1 files changed, 174 insertions, 177 deletions
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