Commit 20825100 authored by Armillon Damien's avatar Armillon Damien
Browse files

linear optimisation

parent f035ab58
......@@ -20,22 +20,44 @@ let rec succs_of_rtl_instrs il : int list =
(* effectue un tri topologique des blocs. *)
let sort_blocks (nodes: (int, rtl_instr list) Hashtbl.t) entry =
let rec add_block order n =
(* TODO *)
List.of_enum (Hashtbl.keys nodes)
if not (List.mem n order) then
let new_order = order @ [n] in
let new_block = Hashtbl.find nodes n in
let successors = List.filter_map (
fun instr -> match instr with
| Rjmp(s) -> Some s
| Rbranch(_,_,_,s) -> Some s
| _ -> None
) new_block in
let a = List.fold_left (fun acc s -> add_block acc s) new_order successors in
a else
order
in
add_block [] entry
(* Supprime les jumps inutiles (Jmp à un label défini juste en dessous). *)
let rec remove_useless_jumps (l: rtl_instr list) =
(* TODO *)
l
match l with
| [] -> []
| Rjmp(s)::Rlabel(s')::r ->
if s = s' then Rlabel(s')::remove_useless_jumps r
else Rjmp(s)::Rlabel(s')::remove_useless_jumps r
| i::r -> i::remove_useless_jumps r
(* Remove labels that are never jumped to. *)
let remove_useless_labels (l: rtl_instr list) =
(* TODO *)
l
let label_to_jump = List.fold_left (fun acc instr ->
match instr with
| Rjmp(s) -> Set.add s acc
| Rbranch(_,_,_,s) -> Set.add s acc
| _ -> acc
) Set.empty l in
List.filter (fun instr ->
match instr with
| Rlabel(s) -> Set.mem s label_to_jump
| _ -> true
) l
let linear_of_rtl_fun
({ rtlfunargs; rtlfunbody; rtlfunentry; rtlfuninfo }: rtl_fun) =
......
Markdown is supported
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