diff options
| -rw-r--r-- | driver/Clflags.ml | 2 | ||||
| -rw-r--r-- | driver/Driver.ml | 2 | ||||
| -rw-r--r-- | riscV/ExpansionOracle.ml | 351 |
3 files changed, 176 insertions, 179 deletions
diff --git a/driver/Clflags.ml b/driver/Clflags.ml index 8d85e93a..ed036f87 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -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 diff --git a/driver/Driver.ml b/driver/Driver.ml index 9750981e..7192ba4b 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -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 *) 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 |