Commit 21d43bc4 authored by Léo Gourdin's avatar Léo Gourdin
Browse files

Remove first nop when doing expansion

parent bc4a980b
......@@ -21,6 +21,7 @@ open DebugPrint
open RTLpath
open! Integers
open Camlcoq
open Option
type sop = Sop of operation * P.t list
......@@ -49,8 +50,7 @@ type immt = Xoriw | Xoril | Sltiw | Sltiuw | Sltil | Sltiul
let find_or_addnmove op args rd succ map_consts =
let sop = Sop (op, args) in
match Hashtbl.find_opt map_consts sop with
| Some r ->
Sr (P.of_int r)
| Some r -> Sr (P.of_int r)
| None ->
Hashtbl.add map_consts sop (p2i rd);
Si (Iop (op, args, rd, succ))
......@@ -205,7 +205,7 @@ let cbranch_int64u is_x0 cmp a1 a2 info succ1 succ2 k =
| Cgt -> Icond (CEbltul optR0, [ a2; a1 ], succ1, succ2, info) :: k
| Cge -> Icond (CEbgeul optR0, [ a1; a2 ], succ1, succ2, info) :: k
let cond_int32s is_x0 cmp a1 a2 dest succ k =
let cond_int32s is_x0 cmp a1 a2 dest tmp_reg succ k =
let optR0 = make_optR0 is_x0 (is_inv_cmp cmp) in
match cmp with
| Ceq -> Iop (OEseqw optR0, [ a1; a2 ], dest, succ) :: k
......@@ -213,15 +213,15 @@ let cond_int32s is_x0 cmp a1 a2 dest succ k =
| Clt -> Iop (OEsltw optR0, [ a1; a2 ], dest, succ) :: k
| Cle ->
let r = r2pi () in
Iop (OEsltw optR0, [ a2; a1 ], r, n2pi ())
Iop (OEsltw optR0, [ a2; a1 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
| Cgt -> Iop (OEsltw optR0, [ a2; a1 ], dest, succ) :: k
| Cge ->
let r = r2pi () in
Iop (OEsltw optR0, [ a1; a2 ], r, n2pi ())
Iop (OEsltw optR0, [ a1; a2 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
let cond_int32u is_x0 cmp a1 a2 dest succ k =
let cond_int32u is_x0 cmp a1 a2 dest tmp_reg succ k =
let optR0 = make_optR0 is_x0 (is_inv_cmp cmp) in
match cmp with
| Ceq -> Iop (OEsequw optR0, [ a1; a2 ], dest, succ) :: k
......@@ -229,15 +229,15 @@ let cond_int32u is_x0 cmp a1 a2 dest succ k =
| Clt -> Iop (OEsltuw optR0, [ a1; a2 ], dest, succ) :: k
| Cle ->
let r = r2pi () in
Iop (OEsltuw optR0, [ a2; a1 ], r, n2pi ())
Iop (OEsltuw optR0, [ a2; a1 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
| Cgt -> Iop (OEsltuw optR0, [ a2; a1 ], dest, succ) :: k
| Cge ->
let r = r2pi () in
Iop (OEsltuw optR0, [ a1; a2 ], r, n2pi ())
Iop (OEsltuw optR0, [ a1; a2 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
let cond_int64s is_x0 cmp a1 a2 dest succ k =
let cond_int64s is_x0 cmp a1 a2 dest tmp_reg succ k =
let optR0 = make_optR0 is_x0 (is_inv_cmp cmp) in
match cmp with
| Ceq -> Iop (OEseql optR0, [ a1; a2 ], dest, succ) :: k
......@@ -245,15 +245,15 @@ let cond_int64s is_x0 cmp a1 a2 dest succ k =
| Clt -> Iop (OEsltl optR0, [ a1; a2 ], dest, succ) :: k
| Cle ->
let r = r2pi () in
Iop (OEsltl optR0, [ a2; a1 ], r, n2pi ())
Iop (OEsltl optR0, [ a2; a1 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
| Cgt -> Iop (OEsltl optR0, [ a2; a1 ], dest, succ) :: k
| Cge ->
let r = r2pi () in
Iop (OEsltl optR0, [ a1; a2 ], r, n2pi ())
Iop (OEsltl optR0, [ a1; a2 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
let cond_int64u is_x0 cmp a1 a2 dest succ k =
let cond_int64u is_x0 cmp a1 a2 dest tmp_reg succ k =
let optR0 = make_optR0 is_x0 (is_inv_cmp cmp) in
match cmp with
| Ceq -> Iop (OEsequl optR0, [ a1; a2 ], dest, succ) :: k
......@@ -261,12 +261,12 @@ let cond_int64u is_x0 cmp a1 a2 dest succ k =
| Clt -> Iop (OEsltul optR0, [ a1; a2 ], dest, succ) :: k
| Cle ->
let r = r2pi () in
Iop (OEsltul optR0, [ a2; a1 ], r, n2pi ())
Iop (OEsltul optR0, [ a2; a1 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
| Cgt -> Iop (OEsltul optR0, [ a2; a1 ], dest, succ) :: k
| Cge ->
let r = r2pi () in
Iop (OEsltul optR0, [ a1; a2 ], r, n2pi ())
Iop (OEsltul optR0, [ a1; a2 ], r, get tmp_reg)
:: Iop (OExoriw Int.one, [ r ], dest, succ) :: k
let is_normal_cmp = function Cne -> false | _ -> true
......@@ -321,14 +321,18 @@ let expanse_cbranchimm_int64u cmp a1 n info succ1 succ2 k map_consts =
let r' = unzip_head_tuple ht r in
fst ht @ cbranch_int64u false cmp a1 r' info succ1 succ2 k
let get_tmp_reg = function Cle | Cge -> Some (n2pi ()) | _ -> None
let expanse_condimm_int32s cmp a1 n dest succ k map_consts =
if Int.eq n Int.zero then cond_int32s true cmp a1 a1 dest succ k
if Int.eq n Int.zero then
let tmp_reg = get_tmp_reg cmp in
cond_int32s true cmp a1 a1 dest tmp_reg succ k
else
match cmp with
| Ceq | Cne ->
let r = r2pi () in
xorimm32 a1 r n (n2pi ())
(cond_int32s true cmp r r dest succ k)
(cond_int32s true cmp r r dest None succ k)
map_consts
| Clt -> sltimm32 a1 dest n succ k map_consts
| Cle ->
......@@ -338,12 +342,14 @@ let expanse_condimm_int32s cmp a1 n dest succ k map_consts =
else sltimm32 a1 dest (Int.add n Int.one) succ k map_consts
| _ ->
let r = r2pi () in
let tmp_reg = get_tmp_reg cmp in
let ht = loadimm32 r n (n2pi ()) map_consts in
let r' = unzip_head_tuple ht r in
fst ht @ cond_int32s false cmp a1 r' dest succ k
fst ht @ cond_int32s false cmp a1 r' dest tmp_reg succ k
let expanse_condimm_int32u cmp a1 n dest succ k map_consts =
if Int.eq n Int.zero then cond_int32u true cmp a1 a1 dest succ k
let tmp_reg = get_tmp_reg cmp in
if Int.eq n Int.zero then cond_int32u true cmp a1 a1 dest tmp_reg succ k
else
match cmp with
| Clt -> sltuimm32 a1 dest n succ k map_consts
......@@ -351,16 +357,18 @@ let expanse_condimm_int32u cmp a1 n dest succ k map_consts =
let r = r2pi () in
let ht = loadimm32 r n (n2pi ()) map_consts in
let r' = unzip_head_tuple ht r in
fst ht @ cond_int32u false cmp a1 r' dest succ k
fst ht @ cond_int32u false cmp a1 r' dest tmp_reg succ k
let expanse_condimm_int64s cmp a1 n dest succ k map_consts =
if Int64.eq n Int64.zero then cond_int64s true cmp a1 a1 dest succ k
if Int64.eq n Int64.zero then
let tmp_reg = get_tmp_reg cmp in
cond_int64s true cmp a1 a1 dest tmp_reg succ k
else
match cmp with
| Ceq | Cne ->
let r = r2pi () in
xorimm64 a1 r n (n2pi ())
(cond_int64s true cmp r r dest succ k)
(cond_int64s true cmp r r dest None succ k)
map_consts
| Clt -> sltimm64 a1 dest n succ k map_consts
| Cle ->
......@@ -370,12 +378,14 @@ let expanse_condimm_int64s cmp a1 n dest succ k map_consts =
else sltimm64 a1 dest (Int64.add n Int64.one) succ k map_consts
| _ ->
let r = r2pi () in
let tmp_reg = get_tmp_reg cmp in
let ht = loadimm64 r n (n2pi ()) map_consts in
let r' = unzip_head_tuple ht r in
fst ht @ cond_int64s false cmp a1 r' dest succ k
fst ht @ cond_int64s false cmp a1 r' dest tmp_reg succ k
let expanse_condimm_int64u cmp a1 n dest succ k map_consts =
if Int64.eq n Int64.zero then cond_int64u true cmp a1 a1 dest succ k
let tmp_reg = get_tmp_reg cmp in
if Int64.eq n Int64.zero then cond_int64u true cmp a1 a1 dest tmp_reg succ k
else
match cmp with
| Clt -> sltuimm64 a1 dest n succ k map_consts
......@@ -383,7 +393,7 @@ let expanse_condimm_int64u cmp a1 n dest succ k map_consts =
let r = r2pi () in
let ht = loadimm64 r n (n2pi ()) map_consts in
let r' = unzip_head_tuple ht r in
fst ht @ cond_int64u false cmp a1 r' dest succ k
fst ht @ cond_int64u false cmp a1 r' dest tmp_reg succ k
let expanse_cond_fp cnot fn_cond cmp f1 f2 dest succ k =
let normal = is_normal_cmp cmp in
......@@ -437,16 +447,22 @@ let write_pathmap initial esize pm' =
in
pm' := PTree.set initial path' !pm'
let rec write_tree exp current code' new_order =
let rec write_tree exp initial current code' new_order =
let target_node, next_node =
if current = !node then (
node := !node + 1;
(P.to_int initial, current))
else (current, current - 1)
in
match exp with
| (Iop (_, _, _, succ) as inst) :: k ->
code' := PTree.set (P.of_int current) inst !code';
new_order := P.of_int current :: !new_order;
write_tree k (current - 1) code' new_order
code' := PTree.set (P.of_int target_node) inst !code';
new_order := P.of_int target_node :: !new_order;
write_tree k initial next_node code' new_order
| (Icond (_, _, succ1, succ2, _) as inst) :: k ->
code' := PTree.set (P.of_int current) inst !code';
new_order := P.of_int current :: !new_order;
write_tree k (current - 1) code' new_order
code' := PTree.set (P.of_int target_node) inst !code';
new_order := P.of_int target_node :: !new_order;
write_tree k initial next_node code' new_order
| [] -> ()
| _ -> failwith "ExpansionOracle.write_tree: inconsistent instruction."
......@@ -462,20 +478,21 @@ let expanse (sb : superblock) code pm =
let map_consts = Hashtbl.create 100 in
Array.iter
(fun n ->
begin (
was_branch := false;
was_exp := false;
let inst = get_some @@ PTree.get n code in
if !Clflags.option_fexpanse_rtlcond then (
(if !Clflags.option_fexpanse_rtlcond then
match inst with
(* Expansion of conditions - Ocmp *)
| Iop (Ocmp (Ccomp c), a1 :: a2 :: nil, dest, succ) ->
debug "Iop/Ccomp\n";
exp := cond_int32s false c a1 a2 dest succ [];
let tmp_reg = get_tmp_reg c in
exp := cond_int32s false c a1 a2 dest tmp_reg succ [];
was_exp := true
| Iop (Ocmp (Ccompu c), a1 :: a2 :: nil, dest, succ) ->
debug "Iop/Ccompu\n";
exp := cond_int32u false c a1 a2 dest succ [];
let tmp_reg = get_tmp_reg c in
exp := cond_int32u false c a1 a2 dest tmp_reg succ [];
was_exp := true
| Iop (Ocmp (Ccompimm (c, imm)), a1 :: nil, dest, succ) ->
debug "Iop/Ccompimm\n";
......@@ -487,11 +504,13 @@ let expanse (sb : superblock) code pm =
was_exp := true
| Iop (Ocmp (Ccompl c), a1 :: a2 :: nil, dest, succ) ->
debug "Iop/Ccompl\n";
exp := cond_int64s false c a1 a2 dest succ [];
let tmp_reg = get_tmp_reg c in
exp := cond_int64s false c a1 a2 dest tmp_reg succ [];
was_exp := true
| Iop (Ocmp (Ccomplu c), a1 :: a2 :: nil, dest, succ) ->
debug "Iop/Ccomplu\n";
exp := cond_int64u false c a1 a2 dest succ [];
let tmp_reg = get_tmp_reg c in
exp := cond_int64u false c a1 a2 dest tmp_reg succ [];
was_exp := true
| Iop (Ocmp (Ccomplimm (c, imm)), a1 :: nil, dest, succ) ->
debug "Iop/Ccomplimm\n";
......@@ -530,12 +549,14 @@ let expanse (sb : superblock) code pm =
was_exp := true
| Icond (Ccompimm (c, imm), a1 :: nil, succ1, succ2, info) ->
debug "Icond/Ccompimm\n";
exp := expanse_cbranchimm_int32s c a1 imm info succ1 succ2 [] map_consts;
exp :=
expanse_cbranchimm_int32s c a1 imm info succ1 succ2 [] map_consts;
was_branch := true;
was_exp := true
| Icond (Ccompuimm (c, imm), a1 :: nil, succ1, succ2, info) ->
debug "Icond/Ccompuimm\n";
exp := expanse_cbranchimm_int32u c a1 imm info succ1 succ2 [] map_consts;
exp :=
expanse_cbranchimm_int32u c a1 imm info succ1 succ2 [] map_consts;
was_branch := true;
was_exp := true
| Icond (Ccompl c, a1 :: a2 :: nil, succ1, succ2, info) ->
......@@ -550,17 +571,20 @@ let expanse (sb : superblock) code pm =
was_exp := true
| Icond (Ccomplimm (c, imm), a1 :: nil, succ1, succ2, info) ->
debug "Icond/Ccomplimm\n";
exp := expanse_cbranchimm_int64s c a1 imm info succ1 succ2 [] map_consts;
exp :=
expanse_cbranchimm_int64s c a1 imm info succ1 succ2 [] map_consts;
was_branch := true;
was_exp := true
| Icond (Ccompluimm (c, imm), a1 :: nil, succ1, succ2, info) ->
debug "Icond/Ccompluimm\n";
exp := expanse_cbranchimm_int64u c a1 imm info succ1 succ2 [] map_consts;
exp :=
expanse_cbranchimm_int64u c a1 imm info succ1 succ2 [] map_consts;
was_branch := true;
was_exp := true
| Icond (Ccompf c, f1 :: f2 :: nil, succ1, succ2, info) ->
debug "Icond/Ccompf\n";
exp := expanse_cbranch_fp false cond_float c f1 f2 info succ1 succ2 [];
exp :=
expanse_cbranch_fp false cond_float c f1 f2 info succ1 succ2 [];
was_branch := true;
was_exp := true
| Icond (Cnotcompf c, f1 :: f2 :: nil, succ1, succ2, info) ->
......@@ -576,11 +600,12 @@ let expanse (sb : superblock) code pm =
was_exp := true
| Icond (Cnotcompfs c, f1 :: f2 :: nil, succ1, succ2, info) ->
debug "Icond/Cnotcompfs\n";
exp := expanse_cbranch_fp true cond_single c f1 f2 info succ1 succ2 [];
exp :=
expanse_cbranch_fp true cond_single c f1 f2 info succ1 succ2 [];
was_branch := true;
was_exp := true
| _ -> ());
if (!Clflags.option_fexpanse_fpconst && not !was_exp) then (
(if !Clflags.option_fexpanse_fpconst && not !was_exp then
match inst with
(* Expansion of fp constants *)
| Iop (Ofloatconst f, nil, dest, succ) ->
......@@ -603,8 +628,8 @@ let expanse (sb : superblock) code pm =
was_exp := true
| _ -> ());
if !was_exp then (
node := !node + 1;
(if !was_branch then
(*node := !node + 1;*)
(*(if !was_branch then
let lives = PTree.get n !liveins in
match lives with
| Some lives ->
......@@ -613,12 +638,11 @@ let expanse (sb : superblock) code pm =
in
liveins := PTree.set new_branch_pc lives !liveins;
liveins := PTree.remove n !liveins
| _ -> ());
write_pathmap sb.instructions.(0) (List.length !exp) pm';
write_initial_node n code' new_order;
write_tree !exp !node code' new_order)
| _ -> ());*)
write_pathmap sb.instructions.(0) (List.length !exp - 1) pm';
(*write_initial_node n code' new_order;*)
write_tree !exp n !node code' new_order)
else new_order := n :: !new_order)
end)
sb.instructions;
sb.instructions <- Array.of_list (List.rev !new_order);
sb.liveins <- !liveins;
......
......@@ -326,6 +326,7 @@ let scheduler f =
(*debug_flag := false;*)
(*print_superblocks lsb code; debug "\n";*)
find_last_node_reg (PTree.elements code);
(*node := !node - 1;*)
let (tc, pm) = do_schedule code pm lsb in
(((tc, entry), pm), id_ptree)
end
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