Skip to content

GitLab

Commit 63ddeebc authored by Léo Gourdin's avatar Léo Gourdin
Browse files

Compiler options to manage expansions

parent 95205e72
Hide whitespace changes
Inline Side-by-side
driver/Clflags.ml
View file @ 63ddeebc
......@@ -106,7 +106,7 @@ let option_div_i32 = ref "stsud"
let option_div_i64 = ref "stsud"
let option_fcoalesce_mem = ref true
let option_fexpanse_rtlcond = ref true
let option_fexpanse_fpconst = ref true
let option_fexpanse_others = ref true
let option_fforward_moves = ref false
let option_fmove_loop_invariants = ref false
let option_fnontrap_loads = ref true
......
driver/Driver.ml
View file @ 63ddeebc
......@@ -445,7 +445,7 @@ let cmdline_actions =
@ f_opt "nontrap-loads" option_fnontrap_loads
@ f_opt "coalesce-mem" option_fcoalesce_mem
@ f_opt "expanse-rtlcond" option_fexpanse_rtlcond
@ f_opt "expanse-fpconst" option_fexpanse_fpconst
@ f_opt "expanse-others" option_fexpanse_others
@ f_opt "all-loads-nontrap" option_all_loads_nontrap
@ f_opt "forward-moves" option_fforward_moves
(* Code generation options *)
......
riscV/ExpansionOracle.ml
View file @ 63ddeebc
......@@ -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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment