diff options
Diffstat (limited to 'riscV/ExpansionOracle.ml')
| -rw-r--r-- | riscV/ExpansionOracle.ml | 967 |
1 files changed, 459 insertions, 508 deletions
diff --git a/riscV/ExpansionOracle.ml b/riscV/ExpansionOracle.ml index 68d4e4d2..49ca7e96 100644 --- a/riscV/ExpansionOracle.ml +++ b/riscV/ExpansionOracle.ml @@ -10,19 +10,29 @@ (* *) (* *************************************************************) -open RTLpathLivegenaux -open RTLpathCommon -open Datatypes -open Maps -open RTL +open BTL open Op -open Asmgen -open RTLpath open! Integers open Camlcoq -open Option -open AST open DebugPrint +open RTLcommonaux +open BTLcommonaux +open AST +open Datatypes +open Maps +open Asmgen + +(** Tools *) + +let rec iblock_to_list ib = + match ib with + | Bseq (ib1, ib2) -> iblock_to_list ib1 @ iblock_to_list ib2 + | _ -> [ ib ] + +let rec list_to_iblock lib = + match lib with + | i1 :: k -> if List.length lib > 1 then Bseq (i1, list_to_iblock k) else i1 + | [] -> failwith "list_to_iblock: called on empty list" (** Mini CSE (a dynamic numbering is applied during expansion. The CSE algorithm is inspired by the "static" one used in backend/CSE.v *) @@ -31,22 +41,12 @@ open DebugPrint let reg = ref 1 -let node = ref 1 - -let p2i r = P.to_int r - let r2p () = P.of_int !reg -let n2p () = P.of_int !node - let r2pi () = reg := !reg + 1; r2p () -let n2pi () = - node := !node + 1; - n2p () - (** Below are the types for rhs and equations *) type rhs = Sop of operation * int list | Smove @@ -54,18 +54,15 @@ type rhs = Sop of operation * int list | Smove type seq = Seq of int * rhs (** This is a mini abstraction to have a simpler representation during expansion - - Snop will be converted to Inop - (Sr r) is inserted if the value was found in register r - - (Sexp dest rhs args succ) represent an instruction - (succesor may not be defined at this point, hence the use of type option) - - (Sfinalcond cond args succ1 succ2 info) represents a condition (which must - always be the last instruction in expansion list *) + - (Sexp dest rhs args iinfo) represent an instruction + - (Scond cond args ib1 ib2 iinfo) represents a condition +*) type expl = - | Snop of P.t | Sr of P.t - | Sexp of P.t * rhs * P.t list * node option - | Sfinalcond of condition * P.t list * node * node * bool option + | Sexp of P.t * rhs * P.t list * inst_info + | Scond of condition * P.t list * iblock * iblock * inst_info (** Record used during the "dynamic" value numbering *) @@ -193,18 +190,15 @@ let extract_arg l = | _ -> failwith "extract_arg: final instruction arg can not be extracted" else failwith "extract_arg: trying to extract on an empty list" -let extract_final vn fl fdest succ = +let extract_final vn fl fdest = if List.length fl > 0 then match List.hd fl with | Sr r -> if not (P.eq r fdest) then ( let v = get_nvalues vn [ r ] in addsop vn v Omove fdest; - Sexp (fdest, Smove, [ r ], Some succ) :: List.tl fl) - else Snop succ :: List.tl fl - | Sexp (rd, rh, args, None) -> - assert (rd = fdest); - Sexp (fdest, rh, args, Some succ) :: List.tl fl + Sexp (fdest, Smove, [ r ], def_iinfo ()) :: List.tl fl) + else List.tl fl | _ -> fl else failwith "extract_final: trying to extract on an empty list" @@ -217,7 +211,7 @@ let addinst vn op args rd = Sr r | None -> addsop vn v op rd; - Sexp (rd, rh, args, None) + Sexp (rd, rh, args, def_iinfo ()) (** Expansion functions *) @@ -344,45 +338,45 @@ let is_inv_cmp = function Cle | Cgt -> true | _ -> false let make_optR is_x0 is_inv = if is_x0 then if is_inv then Some X0_L else Some X0_R else None -let cbranch_int32s is_x0 cmp a1 a2 info succ1 succ2 k = +let cbranch_int32s is_x0 cmp a1 a2 iinfo succ1 succ2 k = let optR = make_optR is_x0 (is_inv_cmp cmp) in match cmp with - | Ceq -> Sfinalcond (CEbeqw optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cne -> Sfinalcond (CEbnew optR, [ a1; a2 ], succ1, succ2, info) :: k - | Clt -> Sfinalcond (CEbltw optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cle -> Sfinalcond (CEbgew optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cgt -> Sfinalcond (CEbltw optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cge -> Sfinalcond (CEbgew optR, [ a1; a2 ], succ1, succ2, info) :: k - -let cbranch_int32u is_x0 cmp a1 a2 info succ1 succ2 k = + | Ceq -> Scond (CEbeqw optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cne -> Scond (CEbnew optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Clt -> Scond (CEbltw optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cle -> Scond (CEbgew optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cgt -> Scond (CEbltw optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cge -> Scond (CEbgew optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + +let cbranch_int32u is_x0 cmp a1 a2 iinfo succ1 succ2 k = let optR = make_optR is_x0 (is_inv_cmp cmp) in match cmp with - | Ceq -> Sfinalcond (CEbequw optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cne -> Sfinalcond (CEbneuw optR, [ a1; a2 ], succ1, succ2, info) :: k - | Clt -> Sfinalcond (CEbltuw optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cle -> Sfinalcond (CEbgeuw optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cgt -> Sfinalcond (CEbltuw optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cge -> Sfinalcond (CEbgeuw optR, [ a1; a2 ], succ1, succ2, info) :: k - -let cbranch_int64s is_x0 cmp a1 a2 info succ1 succ2 k = + | Ceq -> Scond (CEbequw optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cne -> Scond (CEbneuw optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Clt -> Scond (CEbltuw optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cle -> Scond (CEbgeuw optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cgt -> Scond (CEbltuw optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cge -> Scond (CEbgeuw optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + +let cbranch_int64s is_x0 cmp a1 a2 iinfo succ1 succ2 k = let optR = make_optR is_x0 (is_inv_cmp cmp) in match cmp with - | Ceq -> Sfinalcond (CEbeql optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cne -> Sfinalcond (CEbnel optR, [ a1; a2 ], succ1, succ2, info) :: k - | Clt -> Sfinalcond (CEbltl optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cle -> Sfinalcond (CEbgel optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cgt -> Sfinalcond (CEbltl optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cge -> Sfinalcond (CEbgel optR, [ a1; a2 ], succ1, succ2, info) :: k - -let cbranch_int64u is_x0 cmp a1 a2 info succ1 succ2 k = + | Ceq -> Scond (CEbeql optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cne -> Scond (CEbnel optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Clt -> Scond (CEbltl optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cle -> Scond (CEbgel optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cgt -> Scond (CEbltl optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cge -> Scond (CEbgel optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + +let cbranch_int64u is_x0 cmp a1 a2 iinfo succ1 succ2 k = let optR = make_optR is_x0 (is_inv_cmp cmp) in match cmp with - | Ceq -> Sfinalcond (CEbequl optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cne -> Sfinalcond (CEbneul optR, [ a1; a2 ], succ1, succ2, info) :: k - | Clt -> Sfinalcond (CEbltul optR, [ a1; a2 ], succ1, succ2, info) :: k - | Cle -> Sfinalcond (CEbgeul optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cgt -> Sfinalcond (CEbltul optR, [ a2; a1 ], succ1, succ2, info) :: k - | Cge -> Sfinalcond (CEbgeul optR, [ a1; a2 ], succ1, succ2, info) :: k + | Ceq -> Scond (CEbequl optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cne -> Scond (CEbneul optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Clt -> Scond (CEbltul optR, [ a1; a2 ], succ1, succ2, iinfo) :: k + | Cle -> Scond (CEbgeul optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cgt -> Scond (CEbltul optR, [ a2; a1 ], succ1, succ2, iinfo) :: k + | Cge -> Scond (CEbgeul optR, [ a1; a2 ], succ1, succ2, iinfo) :: k let cond_int32s vn is_x0 cmp a1 a2 dest = let optR = make_optR is_x0 (is_inv_cmp cmp) in @@ -484,39 +478,39 @@ let cond_single vn cmp f1 f2 dest = | Cgt -> [ addinst vn OEflts [ f2; f1 ] dest ] | Cge -> [ addinst vn OEfles [ f2; f1 ] dest ] -let expanse_cbranchimm_int32s vn cmp a1 n info succ1 succ2 = - if Int.eq n Int.zero then cbranch_int32s true cmp a1 a1 info succ1 succ2 [] +let expanse_cbranchimm_int32s vn cmp a1 n iinfo succ1 succ2 = + if Int.eq n Int.zero then cbranch_int32s true cmp a1 a1 iinfo succ1 succ2 [] else let r = r2pi () in let l = loadimm32 vn r n in let r', l' = extract_arg l in - cbranch_int32s false cmp a1 r' info succ1 succ2 l' + cbranch_int32s false cmp a1 r' iinfo succ1 succ2 l' -let expanse_cbranchimm_int32u vn cmp a1 n info succ1 succ2 = - if Int.eq n Int.zero then cbranch_int32u true cmp a1 a1 info succ1 succ2 [] +let expanse_cbranchimm_int32u vn cmp a1 n iinfo succ1 succ2 = + if Int.eq n Int.zero then cbranch_int32u true cmp a1 a1 iinfo succ1 succ2 [] else let r = r2pi () in let l = loadimm32 vn r n in let r', l' = extract_arg l in - cbranch_int32u false cmp a1 r' info succ1 succ2 l' + cbranch_int32u false cmp a1 r' iinfo succ1 succ2 l' -let expanse_cbranchimm_int64s vn cmp a1 n info succ1 succ2 = +let expanse_cbranchimm_int64s vn cmp a1 n iinfo succ1 succ2 = if Int64.eq n Int64.zero then - cbranch_int64s true cmp a1 a1 info succ1 succ2 [] + cbranch_int64s true cmp a1 a1 iinfo succ1 succ2 [] else let r = r2pi () in let l = loadimm64 vn r n in let r', l' = extract_arg l in - cbranch_int64s false cmp a1 r' info succ1 succ2 l' + cbranch_int64s false cmp a1 r' iinfo succ1 succ2 l' -let expanse_cbranchimm_int64u vn cmp a1 n info succ1 succ2 = +let expanse_cbranchimm_int64u vn cmp a1 n iinfo succ1 succ2 = if Int64.eq n Int64.zero then - cbranch_int64u true cmp a1 a1 info succ1 succ2 [] + cbranch_int64u true cmp a1 a1 iinfo succ1 succ2 [] else let r = r2pi () in let l = loadimm64 vn r n in let r', l' = extract_arg l in - cbranch_int64u false cmp a1 r' info succ1 succ2 l' + cbranch_int64u false cmp a1 r' iinfo succ1 succ2 l' let expanse_condimm_int32s vn cmp a1 n dest = if Int.eq n Int.zero then cond_int32s vn true cmp a1 a1 dest @@ -593,469 +587,427 @@ let expanse_cond_fp vn cnot fn_cond cmp f1 f2 dest = let r', l = extract_arg insn in addinst vn (OExoriw Int.one) [ r' ] dest :: l -let expanse_cbranch_fp vn cnot fn_cond cmp f1 f2 info succ1 succ2 = +let expanse_cbranch_fp vn cnot fn_cond cmp f1 f2 iinfo succ1 succ2 = let r = r2pi () in let normal = is_normal_cmp cmp in let normal' = if cnot then not normal else normal in let insn = fn_cond vn cmp f1 f2 r in let r', l = extract_arg insn in if normal' then - Sfinalcond (CEbnew (Some X0_R), [ r'; r' ], succ1, succ2, info) :: l - else Sfinalcond (CEbeqw (Some X0_R), [ r'; r' ], succ1, succ2, info) :: l - -(** Form a list containing both sources and destination regs of an instruction *) - -let get_regindent = function Coq_inr _ -> [] | Coq_inl r -> [ r ] - -let get_regs_inst = function - | Inop _ -> [] - | Iop (_, args, dest, _) -> dest :: args - | Iload (_, _, _, args, dest, _) -> dest :: args - | Istore (_, _, args, src, _) -> src :: args - | Icall (_, t, args, dest, _) -> dest :: (get_regindent t @ args) - | Itailcall (_, t, args) -> get_regindent t @ args - | Ibuiltin (_, args, dest, _) -> - AST.params_of_builtin_res dest @ AST.params_of_builtin_args args - | Icond (_, args, _, _, _) -> args - | Ijumptable (arg, _) -> [ arg ] - | Ireturn (Some r) -> [ r ] - | _ -> [] - -(** Modify pathmap according to the size of the expansion list *) - -let write_pathmap initial esize pm' = - debug "write_pathmap: initial=%d, esize=%d\n" (p2i initial) esize; - let path = get_some @@ PTree.get initial !pm' in - let npsize = Camlcoq.Nat.of_int (esize + Camlcoq.Nat.to_int path.psize) in - let path' = - { - psize = npsize; - input_regs = path.input_regs; - pre_output_regs = path.pre_output_regs; - output_regs = path.output_regs; - } - in - pm' := PTree.set initial path' !pm' - -(** Write a single instruction in the tree and update order *) - -let write_inst target_node inst code' new_order = - code' := PTree.set (P.of_int target_node) inst !code'; - new_order := P.of_int target_node :: !new_order + Scond (CEbnew (Some X0_R), [ r'; r' ], succ1, succ2, iinfo) :: l + else Scond (CEbeqw (Some X0_R), [ r'; r' ], succ1, succ2, iinfo) :: l (** Return olds args if the CSE numbering is empty *) let get_arguments vn vals args = match reg_valnums vn vals with Some args' -> args' | None -> args -(** Update the code tree with the expansion list *) - -let rec write_tree vn exp initial current code' new_order fturn = - debug "wt: node is %d\n" !node; - let target_node, next_node = - if fturn then (P.to_int initial, current) else (current, current - 1) - in +let rec gen_btl_list vn exp = match exp with | Sr r :: _ -> failwith "write_tree: there are still some symbolic values in the list" - | Sexp (rd, Sop (op, vals), args, None) :: k -> - let args = get_arguments vn vals args in - let inst = Iop (op, args, rd, P.of_int next_node) in - write_inst target_node inst code' new_order; - write_tree vn k initial next_node code' new_order false - | [ Snop succ ] -> - let inst = Inop succ in - write_inst target_node inst code' new_order - | [ Sexp (rd, Sop (op, vals), args, Some succ) ] -> + | Sexp (rd, Sop (op, vals), args, iinfo) :: k -> let args = get_arguments vn vals args in - let inst = Iop (op, args, rd, succ) in - write_inst target_node inst code' new_order - | [ Sexp (rd, Smove, args, Some succ) ] -> - let inst = Iop (Omove, args, rd, succ) in - write_inst target_node inst code' new_order - | [ Sfinalcond (cond, args, succ1, succ2, info) ] -> - let inst = Icond (cond, args, succ1, succ2, info) in - write_inst target_node inst code' new_order - | [] -> () + let inst = Bop (op, args, rd, iinfo) in + inst :: gen_btl_list vn k + | [ Sexp (rd, Smove, args, iinfo) ] -> [ Bop (Omove, args, rd, iinfo) ] + | [ Scond (cond, args, succ1, succ2, iinfo) ] -> + let ib = Bcond (cond, args, succ1, succ2, iinfo) in + [ ib ] + | [] -> [] | _ -> failwith "write_tree: invalid list" -(** Main expansion function - TODO gourdinl to split? *) -let expanse (sb : superblock) code pm = - debug "#### New superblock for expansion oracle\n"; - let new_order = ref [] in - let liveins = ref sb.liveins in +let expanse_list li = + debug "#### New block for expansion oracle\n"; let exp = ref [] in let was_branch = ref false in let was_exp = ref false in - let code' = ref code in - let pm' = ref pm in let vn = ref (empty_numbering ()) in - Array.iter - (fun n -> - was_branch := false; - was_exp := false; - let inst = get_some @@ PTree.get n code in - (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 vn false c a1 a2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccompu c), a1 :: a2 :: nil, dest, succ) -> - debug "Iop/Ccompu\n"; - exp := cond_int32u vn false c a1 a2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccompimm (c, imm)), a1 :: nil, dest, succ) -> - debug "Iop/Ccompimm\n"; - exp := expanse_condimm_int32s vn c a1 imm dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccompuimm (c, imm)), a1 :: nil, dest, succ) -> - debug "Iop/Ccompuimm\n"; - exp := expanse_condimm_int32u vn c a1 imm dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccompl c), a1 :: a2 :: nil, dest, succ) -> - debug "Iop/Ccompl\n"; - exp := cond_int64s vn false c a1 a2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccomplu c), a1 :: a2 :: nil, dest, succ) -> - debug "Iop/Ccomplu\n"; - exp := cond_int64u vn false c a1 a2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccomplimm (c, imm)), a1 :: nil, dest, succ) -> - debug "Iop/Ccomplimm\n"; - exp := expanse_condimm_int64s vn c a1 imm dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccompluimm (c, imm)), a1 :: nil, dest, succ) -> - debug "Iop/Ccompluimm\n"; - exp := expanse_condimm_int64u vn c a1 imm dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccompf c), f1 :: f2 :: nil, dest, succ) -> - debug "Iop/Ccompf\n"; - exp := expanse_cond_fp vn false cond_float c f1 f2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Cnotcompf c), f1 :: f2 :: nil, dest, succ) -> - debug "Iop/Cnotcompf\n"; - exp := expanse_cond_fp vn true cond_float c f1 f2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Ccompfs c), f1 :: f2 :: nil, dest, succ) -> - debug "Iop/Ccompfs\n"; - exp := expanse_cond_fp vn false cond_single c f1 f2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocmp (Cnotcompfs c), f1 :: f2 :: nil, dest, succ) -> - debug "Iop/Cnotcompfs\n"; - exp := expanse_cond_fp vn true cond_single c f1 f2 dest; - exp := extract_final vn !exp dest succ; - was_exp := true - (* Expansion of branches - Ccomp *) - | Icond (Ccomp c, a1 :: a2 :: nil, succ1, succ2, info) -> - debug "Icond/Ccomp\n"; - exp := cbranch_int32s false c a1 a2 info succ1 succ2 []; - was_branch := true; - was_exp := true - | Icond (Ccompu c, a1 :: a2 :: nil, succ1, succ2, info) -> - debug "Icond/Ccompu\n"; - exp := cbranch_int32u false c a1 a2 info succ1 succ2 []; - was_branch := true; - was_exp := true - | Icond (Ccompimm (c, imm), a1 :: nil, succ1, succ2, info) -> - debug "Icond/Ccompimm\n"; - exp := expanse_cbranchimm_int32s vn c a1 imm info succ1 succ2; - was_branch := true; - was_exp := true - | Icond (Ccompuimm (c, imm), a1 :: nil, succ1, succ2, info) -> - debug "Icond/Ccompuimm\n"; - exp := expanse_cbranchimm_int32u vn c a1 imm info succ1 succ2; - was_branch := true; - was_exp := true - | Icond (Ccompl c, a1 :: a2 :: nil, succ1, succ2, info) -> - debug "Icond/Ccompl\n"; - exp := cbranch_int64s false c a1 a2 info succ1 succ2 []; - was_branch := true; - was_exp := true - | Icond (Ccomplu c, a1 :: a2 :: nil, succ1, succ2, info) -> - debug "Icond/Ccomplu\n"; - exp := cbranch_int64u false c a1 a2 info succ1 succ2 []; - was_branch := true; - was_exp := true - | Icond (Ccomplimm (c, imm), a1 :: nil, succ1, succ2, info) -> - debug "Icond/Ccomplimm\n"; - exp := expanse_cbranchimm_int64s vn c a1 imm info succ1 succ2; - was_branch := true; - was_exp := true - | Icond (Ccompluimm (c, imm), a1 :: nil, succ1, succ2, info) -> - debug "Icond/Ccompluimm\n"; - exp := expanse_cbranchimm_int64u vn c a1 imm info succ1 succ2; - was_branch := true; - was_exp := true - | Icond (Ccompf c, f1 :: f2 :: nil, succ1, succ2, info) -> - debug "Icond/Ccompf\n"; - exp := - expanse_cbranch_fp vn false cond_float c f1 f2 info succ1 succ2; - was_branch := true; - was_exp := true - | Icond (Cnotcompf c, f1 :: f2 :: nil, succ1, succ2, info) -> - debug "Icond/Cnotcompf\n"; - exp := expanse_cbranch_fp vn true cond_float c f1 f2 info succ1 succ2; - was_branch := true; - was_exp := true - | Icond (Ccompfs c, f1 :: f2 :: nil, succ1, succ2, info) -> - debug "Icond/Ccompfs\n"; - exp := - expanse_cbranch_fp vn false cond_single c f1 f2 info succ1 succ2; - was_branch := true; - was_exp := true - | Icond (Cnotcompfs c, f1 :: f2 :: nil, succ1, succ2, info) -> - debug "Icond/Cnotcompfs\n"; - exp := - expanse_cbranch_fp vn true cond_single c f1 f2 info succ1 succ2; - was_branch := true; - was_exp := true - | _ -> ()); - (if !Clflags.option_fexpanse_others && not !was_exp then - match inst with - | Iop (Ofloatconst f, nil, dest, succ) -> ( - match make_immed64 (Floats.Float.to_bits f) with - | Imm64_single _ | Imm64_large _ -> () - | Imm64_pair (hi, lo) -> - debug "Iop/Ofloatconst\n"; - let r = r2pi () in - let l = load_hilo64 vn r hi lo in - let r', l' = extract_arg l in - exp := addinst vn Ofloat_of_bits [ r' ] dest :: l'; - exp := extract_final vn !exp dest succ; - was_exp := true) - | Iop (Osingleconst f, nil, dest, succ) -> ( - match make_immed32 (Floats.Float32.to_bits f) with - | Imm32_single imm -> () - | Imm32_pair (hi, lo) -> - debug "Iop/Osingleconst\n"; - let r = r2pi () in - let l = load_hilo32 vn r hi lo in - let r', l' = extract_arg l in - exp := addinst vn Osingle_of_bits [ r' ] dest :: l'; - exp := extract_final vn !exp dest succ; - was_exp := true) - | Iop (Ointconst n, nil, dest, succ) -> - debug "Iop/Ointconst\n"; - exp := loadimm32 vn dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Olongconst n, nil, dest, succ) -> - debug "Iop/Olongconst\n"; - exp := loadimm64 vn dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oaddimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oaddimm\n"; - exp := addimm32 vn a1 dest n None; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oaddlimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oaddlimm\n"; - exp := addimm64 vn a1 dest n None; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oandimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oandimm\n"; - exp := andimm32 vn a1 dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oandlimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oandlimm\n"; - exp := andimm64 vn a1 dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oorimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oorimm\n"; - exp := orimm32 vn a1 dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oorlimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oorlimm\n"; - exp := orimm64 vn a1 dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oxorimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oxorimm\n"; - exp := xorimm32 vn a1 dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oxorlimm n, a1 :: nil, dest, succ) -> - debug "Iop/Oxorlimm\n"; - exp := xorimm64 vn a1 dest n; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocast8signed, a1 :: nil, dest, succ) -> - debug "Iop/cast8signed\n"; - let op = Oshlimm (Int.repr (Z.of_sint 24)) in - let r = r2pi () in - let i1 = addinst vn op [ a1 ] r in - let r', l = extract_arg [ i1 ] in - exp := - addinst vn (Oshrimm (Int.repr (Z.of_sint 24))) [ r' ] dest :: l; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocast16signed, a1 :: nil, dest, succ) -> - debug "Iop/cast16signed\n"; - let op = Oshlimm (Int.repr (Z.of_sint 16)) in - let r = r2pi () in - let i1 = addinst vn op [ a1 ] r in - let r', l = extract_arg [ i1 ] in - exp := - addinst vn (Oshrimm (Int.repr (Z.of_sint 16))) [ r' ] dest :: l; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Ocast32unsigned, a1 :: nil, dest, succ) -> - debug "Iop/Ocast32unsigned\n"; - let r1 = r2pi () in - let r2 = r2pi () in - let op1 = Ocast32signed in - let i1 = addinst vn op1 [ a1 ] r1 in - let r1', l1 = extract_arg [ i1 ] in - - let op2 = Oshllimm (Int.repr (Z.of_sint 32)) in - let i2 = addinst vn op2 [ r1' ] r2 in - let r2', l2 = extract_arg (i2 :: l1) in - - let op3 = Oshrluimm (Int.repr (Z.of_sint 32)) in - exp := addinst vn op3 [ r2' ] dest :: l2; - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oshrximm n, a1 :: nil, dest, succ) -> - if Int.eq n Int.zero then ( - debug "Iop/Oshrximm1\n"; - exp := [ addinst vn (OEmayundef (MUshrx n)) [ a1; a1 ] dest ]) - else if Int.eq n Int.one then ( - debug "Iop/Oshrximm2\n"; - let r1 = r2pi () in - let r2 = r2pi () in - let op1 = Oshruimm (Int.repr (Z.of_sint 31)) in - let i1 = addinst vn op1 [ a1 ] r1 in - let r1', l1 = extract_arg [ i1 ] in - - let op2 = Oadd in - let i2 = addinst vn op2 [ a1; r1' ] r2 in - let r2', l2 = extract_arg (i2 :: l1) in - - let op3 = Oshrimm Int.one in - let i3 = addinst vn op3 [ r2' ] dest in - let r3, l3 = extract_arg (i3 :: l2) in - exp := addinst vn (OEmayundef (MUshrx n)) [ r3; r3 ] dest :: l3) - else ( - debug "Iop/Oshrximm3\n"; + let rec expanse_list_rec li = + match li with + | [] -> li + | i :: li' -> + was_branch := false; + was_exp := false; + (if !Clflags.option_fexpanse_rtlcond then + match i with + (* Expansion of conditions - Ocmp *) + | Bop (Ocmp (Ccomp c), a1 :: a2 :: nil, dest, iinfo) -> + debug "Bop/Ccomp\n"; + exp := cond_int32s vn false c a1 a2 dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccompu c), a1 :: a2 :: nil, dest, iinfo) -> + debug "Bop/Ccompu\n"; + exp := cond_int32u vn false c a1 a2 dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccompimm (c, imm)), a1 :: nil, dest, iinfo) -> + debug "Bop/Ccompimm\n"; + exp := expanse_condimm_int32s vn c a1 imm dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccompuimm (c, imm)), a1 :: nil, dest, iinfo) -> + debug "Bop/Ccompuimm\n"; + exp := expanse_condimm_int32u vn c a1 imm dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccompl c), a1 :: a2 :: nil, dest, iinfo) -> + debug "Bop/Ccompl\n"; + exp := cond_int64s vn false c a1 a2 dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccomplu c), a1 :: a2 :: nil, dest, iinfo) -> + debug "Bop/Ccomplu\n"; + exp := cond_int64u vn false c a1 a2 dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccomplimm (c, imm)), a1 :: nil, dest, iinfo) -> + debug "Bop/Ccomplimm\n"; + exp := expanse_condimm_int64s vn c a1 imm dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccompluimm (c, imm)), a1 :: nil, dest, iinfo) -> + debug "Bop/Ccompluimm\n"; + exp := expanse_condimm_int64u vn c a1 imm dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccompf c), f1 :: f2 :: nil, dest, iinfo) -> + debug "Bop/Ccompf\n"; + exp := expanse_cond_fp vn false cond_float c f1 f2 dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Cnotcompf c), f1 :: f2 :: nil, dest, iinfo) -> + debug "Bop/Cnotcompf\n"; + exp := expanse_cond_fp vn true cond_float c f1 f2 dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Ccompfs c), f1 :: f2 :: nil, dest, iinfo) -> + debug "Bop/Ccompfs\n"; + exp := expanse_cond_fp vn false cond_single c f1 f2 dest; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocmp (Cnotcompfs c), f1 :: f2 :: nil, dest, iinfo) -> + debug "Bop/Cnotcompfs\n"; + exp := expanse_cond_fp vn true cond_single c f1 f2 dest; + exp := extract_final vn !exp dest; + was_exp := true + (* Expansion of branches - Ccomp *) + | Bcond (Ccomp c, a1 :: a2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccomp\n"; + exp := cbranch_int32s false c a1 a2 iinfo succ1 succ2 []; + was_branch := true; + was_exp := true + | Bcond (Ccompu c, a1 :: a2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccompu\n"; + exp := cbranch_int32u false c a1 a2 iinfo succ1 succ2 []; + was_branch := true; + was_exp := true + | Bcond (Ccompimm (c, imm), a1 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccompimm\n"; + exp := expanse_cbranchimm_int32s vn c a1 imm iinfo succ1 succ2; + was_branch := true; + was_exp := true + | Bcond (Ccompuimm (c, imm), a1 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccompuimm\n"; + exp := expanse_cbranchimm_int32u vn c a1 imm iinfo succ1 succ2; + was_branch := true; + was_exp := true + | Bcond (Ccompl c, a1 :: a2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccompl\n"; + exp := cbranch_int64s false c a1 a2 iinfo succ1 succ2 []; + was_branch := true; + was_exp := true + | Bcond (Ccomplu c, a1 :: a2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccomplu\n"; + exp := cbranch_int64u false c a1 a2 iinfo succ1 succ2 []; + was_branch := true; + was_exp := true + | Bcond (Ccomplimm (c, imm), a1 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccomplimm\n"; + exp := expanse_cbranchimm_int64s vn c a1 imm iinfo succ1 succ2; + was_branch := true; + was_exp := true + | Bcond (Ccompluimm (c, imm), a1 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccompluimm\n"; + exp := expanse_cbranchimm_int64u vn c a1 imm iinfo succ1 succ2; + was_branch := true; + was_exp := true + | Bcond (Ccompf c, f1 :: f2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccompf\n"; + exp := + expanse_cbranch_fp vn false cond_float c f1 f2 iinfo succ1 succ2; + was_branch := true; + was_exp := true + | Bcond (Cnotcompf c, f1 :: f2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Cnotcompf\n"; + exp := + expanse_cbranch_fp vn true cond_float c f1 f2 iinfo succ1 succ2; + was_branch := true; + was_exp := true + | Bcond (Ccompfs c, f1 :: f2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Ccompfs\n"; + exp := + expanse_cbranch_fp vn false cond_single c f1 f2 iinfo succ1 succ2; + was_branch := true; + was_exp := true + | Bcond (Cnotcompfs c, f1 :: f2 :: nil, succ1, succ2, iinfo) -> + debug "Bcond/Cnotcompfs\n"; + exp := + expanse_cbranch_fp vn true cond_single c f1 f2 iinfo succ1 succ2; + was_branch := true; + was_exp := true + | _ -> ()); + (if !Clflags.option_fexpanse_others && not !was_exp then + match i with + (* Others expansions *) + | Bop (Ofloatconst f, nil, dest, iinfo) -> ( + match make_immed64 (Floats.Float.to_bits f) with + | Imm64_single _ | Imm64_large _ -> () + | Imm64_pair (hi, lo) -> + debug "Bop/Ofloatconst\n"; + let r = r2pi () in + let l = load_hilo64 vn r hi lo in + let r', l' = extract_arg l in + exp := addinst vn Ofloat_of_bits [ r' ] dest :: l'; + exp := extract_final vn !exp dest; + was_exp := true) + | Bop (Osingleconst f, nil, dest, iinfo) -> ( + match make_immed32 (Floats.Float32.to_bits f) with + | Imm32_single imm -> () + | Imm32_pair (hi, lo) -> + debug "Bop/Osingleconst\n"; + let r = r2pi () in + let l = load_hilo32 vn r hi lo in + let r', l' = extract_arg l in + exp := addinst vn Osingle_of_bits [ r' ] dest :: l'; + exp := extract_final vn !exp dest; + was_exp := true) + | Bop (Ointconst n, nil, dest, iinfo) -> + debug "Bop/Ointconst\n"; + exp := loadimm32 vn dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Olongconst n, nil, dest, iinfo) -> + debug "Bop/Olongconst\n"; + exp := loadimm64 vn dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oaddimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oaddimm\n"; + exp := addimm32 vn a1 dest n None; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oaddlimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oaddlimm\n"; + exp := addimm64 vn a1 dest n None; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oandimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oandimm\n"; + exp := andimm32 vn a1 dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oandlimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oandlimm\n"; + exp := andimm64 vn a1 dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oorimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oorimm\n"; + exp := orimm32 vn a1 dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oorlimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oorlimm\n"; + exp := orimm64 vn a1 dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oxorimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oxorimm\n"; + exp := xorimm32 vn a1 dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oxorlimm n, a1 :: nil, dest, iinfo) -> + debug "Bop/Oxorlimm\n"; + exp := xorimm64 vn a1 dest n; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocast8signed, a1 :: nil, dest, iinfo) -> + debug "Bop/cast8signed\n"; + let op = Oshlimm (Int.repr (Z.of_sint 24)) in + let r = r2pi () in + let i1 = addinst vn op [ a1 ] r in + let r', l = extract_arg [ i1 ] in + exp := + addinst vn (Oshrimm (Int.repr (Z.of_sint 24))) [ r' ] dest :: l; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocast16signed, a1 :: nil, dest, iinfo) -> + debug "Bop/cast16signed\n"; + let op = Oshlimm (Int.repr (Z.of_sint 16)) in + let r = r2pi () in + let i1 = addinst vn op [ a1 ] r in + let r', l = extract_arg [ i1 ] in + exp := + addinst vn (Oshrimm (Int.repr (Z.of_sint 16))) [ r' ] dest :: l; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Ocast32unsigned, a1 :: nil, dest, iinfo) -> + debug "Bop/Ocast32unsigned\n"; let r1 = r2pi () in let r2 = r2pi () in - let r3 = r2pi () in - let op1 = Oshrimm (Int.repr (Z.of_sint 31)) in + let op1 = Ocast32signed in let i1 = addinst vn op1 [ a1 ] r1 in let r1', l1 = extract_arg [ i1 ] in - let op2 = Oshruimm (Int.sub Int.iwordsize n) in + let op2 = Oshllimm (Int.repr (Z.of_sint 32)) in let i2 = addinst vn op2 [ r1' ] r2 in let r2', l2 = extract_arg (i2 :: l1) in - let op3 = Oadd in - let i3 = addinst vn op3 [ a1; r2' ] r3 in - let r3', l3 = extract_arg (i3 :: l2) in - - let op4 = Oshrimm n in - let i4 = addinst vn op4 [ r3' ] dest in - let r4, l4 = extract_arg (i4 :: l3) in - exp := addinst vn (OEmayundef (MUshrx n)) [ r4; r4 ] dest :: l4); - exp := extract_final vn !exp dest succ; - was_exp := true - | Iop (Oshrxlimm n, a1 :: nil, dest, succ) -> - if Int.eq n Int.zero then ( - debug "Iop/Oshrxlimm1\n"; - exp := [ addinst vn (OEmayundef (MUshrxl n)) [ a1; a1 ] dest ]) - else if Int.eq n Int.one then ( - debug "Iop/Oshrxlimm2\n"; - let r1 = r2pi () in - let r2 = r2pi () in - let op1 = Oshrluimm (Int.repr (Z.of_sint 63)) in - let i1 = addinst vn op1 [ a1 ] r1 in - let r1', l1 = extract_arg [ i1 ] in + let op3 = Oshrluimm (Int.repr (Z.of_sint 32)) in + exp := addinst vn op3 [ r2' ] dest :: l2; + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oshrximm n, a1 :: nil, dest, iinfo) -> + if Int.eq n Int.zero then ( + debug "Bop/Oshrximm1\n"; + exp := [ addinst vn (OEmayundef (MUshrx n)) [ a1; a1 ] dest ]) + else if Int.eq n Int.one then ( + debug "Bop/Oshrximm2\n"; + let r1 = r2pi () in + let r2 = r2pi () in + let op1 = Oshruimm (Int.repr (Z.of_sint 31)) in + let i1 = addinst vn op1 [ a1 ] r1 in + let r1', l1 = extract_arg [ i1 ] in + + let op2 = Oadd in + let i2 = addinst vn op2 [ a1; r1' ] r2 in + let r2', l2 = extract_arg (i2 :: l1) in + + let op3 = Oshrimm Int.one in + let i3 = addinst vn op3 [ r2' ] dest in + let r3, l3 = extract_arg (i3 :: l2) in + exp := addinst vn (OEmayundef (MUshrx n)) [ r3; r3 ] dest :: l3) + else ( + debug "Bop/Oshrximm3\n"; + let r1 = r2pi () in + let r2 = r2pi () in + let r3 = r2pi () in + let op1 = Oshrimm (Int.repr (Z.of_sint 31)) in + let i1 = addinst vn op1 [ a1 ] r1 in + let r1', l1 = extract_arg [ i1 ] in + + let op2 = Oshruimm (Int.sub Int.iwordsize n) in + let i2 = addinst vn op2 [ r1' ] r2 in + let r2', l2 = extract_arg (i2 :: l1) in + + let op3 = Oadd in + let i3 = addinst vn op3 [ a1; r2' ] r3 in + let r3', l3 = extract_arg (i3 :: l2) in + + let op4 = Oshrimm n in + let i4 = addinst vn op4 [ r3' ] dest in + let r4, l4 = extract_arg (i4 :: l3) in + exp := addinst vn (OEmayundef (MUshrx n)) [ r4; r4 ] dest :: l4); + exp := extract_final vn !exp dest; + was_exp := true + | Bop (Oshrxlimm n, a1 :: nil, dest, iinfo) -> + if Int.eq n Int.zero then ( + debug "Bop/Oshrxlimm1\n"; + exp := [ addinst vn (OEmayundef (MUshrxl n)) [ a1; a1 ] dest ]) + else if Int.eq n Int.one then ( + debug "Bop/Oshrxlimm2\n"; + let r1 = r2pi () in + let r2 = r2pi () in + let op1 = Oshrluimm (Int.repr (Z.of_sint 63)) in + let i1 = addinst vn op1 [ a1 ] r1 in + let r1', l1 = extract_arg [ i1 ] in + + let op2 = Oaddl in + let i2 = addinst vn op2 [ a1; r1' ] r2 in + let r2', l2 = extract_arg (i2 :: l1) in + + let op3 = Oshrlimm Int.one in + let i3 = addinst vn op3 [ r2' ] dest in + let r3, l3 = extract_arg (i3 :: l2) in + exp := addinst vn (OEmayundef (MUshrxl n)) [ r3; r3 ] dest :: l3) + else ( + debug "Bop/Oshrxlimm3\n"; + let r1 = r2pi () in + let r2 = r2pi () in + let r3 = r2pi () in + let op1 = Oshrlimm (Int.repr (Z.of_sint 63)) in + let i1 = addinst vn op1 [ a1 ] r1 in + let r1', l1 = extract_arg [ i1 ] in + + let op2 = Oshrluimm (Int.sub Int64.iwordsize' n) in + let i2 = addinst vn op2 [ r1' ] r2 in + let r2', l2 = extract_arg (i2 :: l1) in + + let op3 = Oaddl in + let i3 = addinst vn op3 [ a1; r2' ] r3 in + let r3', l3 = extract_arg (i3 :: l2) in + + let op4 = Oshrlimm n in + let i4 = addinst vn op4 [ r3' ] dest in + let r4, l4 = extract_arg (i4 :: l3) in + exp := addinst vn (OEmayundef (MUshrxl n)) [ r4; r4 ] dest :: l4); + exp := extract_final vn !exp dest; + was_exp := true + | _ -> ()); + if not !was_exp then ( + (match i with + | Bop (op, args, dest, iinfo) -> + let v = get_nvalues vn args in + addsop vn v op dest + | Bload (_, _, _, _, dst, _) -> set_unknown vn dst + | Bstore (_, _, _, _, _) -> + !vn.seqs <- kill_mem_operations !vn.seqs + (* TODO gourdinl empty numb BF? vn := empty_numbering ()*) + | _ -> ()); + i :: expanse_list_rec li') + else + let hd = gen_btl_list vn (List.rev !exp) in + hd @ expanse_list_rec li' + in + expanse_list_rec li - let op2 = Oaddl in - let i2 = addinst vn op2 [ a1; r1' ] r2 in - let r2', l2 = extract_arg (i2 :: l1) in +let expanse n ibf btl = + (*debug_flag := true;*) + let lib = iblock_to_list ibf.entry in + let new_lib = expanse_list lib in + let ibf' = + { + entry = list_to_iblock new_lib; + input_regs = ibf.input_regs; + binfo = ibf.binfo; + } + in + (*debug_flag := false;*) + PTree.set n ibf' btl - let op3 = Oshrlimm Int.one in - let i3 = addinst vn op3 [ r2' ] dest in - let r3, l3 = extract_arg (i3 :: l2) in - exp := addinst vn (OEmayundef (MUshrxl n)) [ r3; r3 ] dest :: l3) - else ( - debug "Iop/Oshrxlimm3\n"; - let r1 = r2pi () in - let r2 = r2pi () in - let r3 = r2pi () in - let op1 = Oshrlimm (Int.repr (Z.of_sint 63)) in - let i1 = addinst vn op1 [ a1 ] r1 in - let r1', l1 = extract_arg [ i1 ] in +(** Form a list containing both sources and destination regs of a block *) +let get_regindent = function Coq_inr _ -> [] | Coq_inl r -> [ r ] - let op2 = Oshrluimm (Int.sub Int64.iwordsize' n) in - let i2 = addinst vn op2 [ r1' ] r2 in - let r2', l2 = extract_arg (i2 :: l1) in +let rec get_regs_ib = function + | Bnop _ -> [] + | Bop (_, args, dest, _) -> dest :: args + | Bload (_, _, _, args, dest, _) -> dest :: args + | Bstore (_, _, args, src, _) -> src :: args + | Bcond (_, args, ib1, ib2, _) -> get_regs_ib ib1 @ get_regs_ib ib2 @ args + | Bseq (ib1, ib2) -> get_regs_ib ib1 @ get_regs_ib ib2 + | BF (Breturn (Some r), _) -> [ r ] + | BF (Bcall (_, t, args, dest, _), _) -> dest :: (get_regindent t @ args) + | BF (Btailcall (_, t, args), _) -> get_regindent t @ args + | BF (Bbuiltin (_, args, dest, _), _) -> + AST.params_of_builtin_res dest @ AST.params_of_builtin_args args + | BF (Bjumptable (arg, _), _) -> [ arg ] + | _ -> [] - let op3 = Oaddl in - let i3 = addinst vn op3 [ a1; r2' ] r3 in - let r3', l3 = extract_arg (i3 :: l2) in - - let op4 = Oshrlimm n in - let i4 = addinst vn op4 [ r3' ] dest in - let r4, l4 = extract_arg (i4 :: l3) in - exp := addinst vn (OEmayundef (MUshrxl n)) [ r4; r4 ] dest :: l4); - exp := extract_final vn !exp dest succ; - was_exp := true - | _ -> ()); - (* Update the CSE numbering *) - (if not !was_exp then - match inst with - | Iop (op, args, dest, succ) -> - let v = get_nvalues vn args in - addsop vn v op dest - | Iload (_, _, _, _, dst, _) -> set_unknown vn dst - | Istore (chk, addr, args, src, s) -> - !vn.seqs <- kill_mem_operations !vn.seqs - | Icall (_, _, _, _, _) | Itailcall (_, _, _) | Ibuiltin (_, _, _, _) -> - vn := empty_numbering () - | _ -> ()); - (* Update code, liveins, pathmap, and order of the superblock for one expansion *) - if !was_exp then ( - (if !was_branch && List.length !exp > 1 then - let lives = PTree.get n !liveins in - match lives with - | Some lives -> - let new_branch_pc = P.of_int (!node + 1) in - liveins := PTree.set new_branch_pc lives !liveins; - liveins := PTree.remove n !liveins - | _ -> ()); - node := !node + List.length !exp - 1; - write_pathmap sb.instructions.(0) (List.length !exp - 1) pm'; - write_tree vn (List.rev !exp) n !node code' new_order true) - else new_order := n :: !new_order) - sb.instructions; - sb.instructions <- Array.of_list (List.rev !new_order); - sb.liveins <- !liveins; - (!code', !pm') - -(** Compute the last used node and reg indexs *) - -let rec find_last_node_reg = function +let rec find_last_reg = function | [] -> () - | (pc, i) :: k -> + | (pc, ibf) :: k -> let rec traverse_list var = function | [] -> () | e :: t -> @@ -1063,6 +1015,5 @@ let rec find_last_node_reg = function if e' > !var then var := e'; traverse_list var t in - traverse_list node [ pc ]; - traverse_list reg (get_regs_inst i); - find_last_node_reg k + traverse_list reg (get_regs_ib ibf.entry); + find_last_reg k |