diff --git a/src/linear_gen.ml b/src/linear_gen.ml index c12bd04588cfef6a06de11d299bd2ebcd26c09c3..cd83debf7a2e680757984e414ceadd9f838af7cb 100644 --- a/src/linear_gen.ml +++ b/src/linear_gen.ml @@ -19,23 +19,41 @@ 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) + let rec add_block order visited n = + (* TODO *) + List.of_enum (Hashtbl.keys nodes) + (*if Set.mem n visited + then order + else let succs = succs_of_rtl_instrs (Hashtbl.find nodes n) + in List.concat( (order@[n]) :: List.map (add_block [] (Set.add n visited)) succs )*) in - add_block [] entry + add_block [] Set.empty entry (* Supprime les jumps inutiles (Jmp à un label défini juste en dessous). *) let rec remove_useless_jumps (l: rtl_instr list) = - (* TODO *) - l + (* TODO *) + l + (*match l with + | [] -> [] + | Rjmp l1::Rlabel l2::rest -> + if l1=l2 + then Rlabel l2::remove_useless_jumps rest + else Rjmp l1::Rlabel l2::remove_useless_jumps rest + | i::rest -> i::remove_useless_jumps rest*) (* Remove labels that are never jumped to. *) let remove_useless_labels (l: rtl_instr list) = - (* TODO *) - l + (* TODO *) + l + (*List.filter (function + Rlabel i -> List.exists ( + function + Rbranch(_, _, _, j) -> j = i + | Rjmp j -> j = i + | _ -> false) l + | _ -> true) l*) let linear_of_rtl_fun ({ rtlfunargs; rtlfunbody; rtlfunentry; rtlfuninfo }: rtl_fun) = diff --git a/src/regalloc.ml b/src/regalloc.ml index c68b9fdcb599dfb74185b339459873603ebc8e42..a843912751dda2257c0f17aeb3ee37755354503b 100644 --- a/src/regalloc.ml +++ b/src/regalloc.ml @@ -55,7 +55,7 @@ let regalloc_on_stack_fun (f: linear_fun) : ((reg, loc) Hashtbl.t * int)= avec le registre-clé. Cela correspond à la relation d'adjacence dans le graphe d'interférence. *) -(* La fonction [add_to_interf rig x y] ajoute [y] à la liste des registres qui +(* La fonction [add_to_interf rig x y] ajoute [y] à la liste des regiNosstres qui interfèrent avec [x] dans le graphe [rig]. On pourra utiliser la fonction [Hashtbl.modify_def] qui permet de modifier la @@ -79,7 +79,8 @@ let regalloc_on_stack_fun (f: linear_fun) : ((reg, loc) Hashtbl.t * int)= let add_interf (rig : (reg, reg Set.t) Hashtbl.t) (x: reg) (y: reg) : unit = (* TODO *) - () + Hashtbl.modify_def Set.empty x (Set.add y) rig; + Hashtbl.modify_def Set.empty y (Set.add x) rig (* [make_interf_live rig live] ajoute des arcs dans le graphe d'interférence @@ -89,7 +90,7 @@ let make_interf_live (rig: (reg, reg Set.t) Hashtbl.t) (live : (int, reg Set.t) Hashtbl.t) : unit = (* TODO *) - () + Hashtbl.iter (fun i regs -> Set.iter (fun x -> Set.iter (fun y -> if x < y then add_interf rig x y) regs) regs) live (* [build_interference_graph live_out] construit, en utilisant les fonctions que vous avez écrites, le graphe d'interférence en fonction de la vivacité des @@ -120,8 +121,11 @@ let build_interference_graph (live_out : (int, reg Set.t) Hashtbl.t) code : (reg (* [remove_from_rig rig v] supprime le sommet [v] du graphe d'interférences [rig]. *) let remove_from_rig (rig : (reg, reg Set.t) Hashtbl.t) (v: reg) : unit = - (* TODO *) - () + (* TODO *) + while Hashtbl.mem rig v do + Hashtbl.remove rig v + done; + Hashtbl.iter (fun x regs -> Hashtbl.modify x (Set.remove v) rig) rig (* Type représentant les différentes décisions qui peuvent être prises par @@ -159,8 +163,8 @@ type regalloc_decision = possédant strictement moins de [n] voisins. Retourne [None] si aucun sommet ne satisfait cette condition. *) let pick_node_with_fewer_than_n_neighbors (rig : (reg, reg Set.t) Hashtbl.t) (n: int) : reg option = - (* TODO *) - None + (* TODO *) + Hashtbl.fold (fun x regs acc -> if (Set.cardinal regs) < n then Some x else acc) rig None (* Lorsque la fonction précédente échoue (i.e. aucun sommet n'a moins de [n] voisins), on choisit un pseudo-registre à évincer. @@ -171,24 +175,30 @@ let pick_node_with_fewer_than_n_neighbors (rig : (reg, reg Set.t) Hashtbl.t) (n: [pick_spilling_candidate rig] retourne donc le pseudo-registre [r] qui a le plus de voisins dans [rig], ou [None] si [rig] est vide. *) let pick_spilling_candidate (rig : (reg, reg Set.t) Hashtbl.t) : reg option = - (* TODO *) - None + (* TODO *) + let candidate_number_of_neighbours = Hashtbl.fold (fun x regs acc -> + match acc with + | None -> Some (x, Set.cardinal regs) + | Some (y, k) -> if Set.cardinal regs > k then Some (x, Set.cardinal regs) else acc + ) rig None + in match candidate_number_of_neighbours with + | None -> None + | Some (y, k) -> Some y (* [make_stack rig stack ncolors] construit la pile, selon l'algorithme vu en cours (slide 26 du cours "Allocation de registres" présent sur Edunao.) *) let rec make_stack (rig : (reg, reg Set.t) Hashtbl.t) (stack : regalloc_decision list) (ncolors: int) : regalloc_decision list = - (* TODO *) - stack + (* TODO *) + match pick_node_with_fewer_than_n_neighbors rig ncolors with + | Some r -> remove_from_rig rig r; make_stack rig (NoSpill r :: stack) ncolors + | None -> + match pick_spilling_candidate rig with + | Some r -> remove_from_rig rig r; make_stack rig (Spill r :: stack) ncolors + | None -> stack (* Maintenant que nous avons une pile de [regalloc_decision], il est temps de - colorer notre graphe, i.e. associer une couleur (un numéro de registre - physique) à chaque pseudo-registre. Nous allons parcourir la pile et pour - chaque décision : - - -  [Spill r] : associer un emplacement sur la pile au pseudo-registre [r]. On - choisira l'emplacement [next_stack_slot]. - + colorer notre graphe, i.e. associer une couleur (un numéro de restack@[NoSpill r] - [NoSpill r] : associer une couleur (un registre) physique au pseudo-registre [r]. On choisira une couleur qui n'est pas déjà associée à un voisin de [r] dans [rig]. @@ -218,8 +228,18 @@ let allocate (allocation: (reg, loc) Hashtbl.t) (rig: (reg, reg Set.t) Hashtbl.t (all_colors: int Set.t) (next_stack_slot: int) (decision: regalloc_decision) : int = - (* TODO *) - next_stack_slot + (* TODO *) + match decision with + | Spill r -> Hashtbl.add allocation r (Stk next_stack_slot); next_stack_slot-1 + | NoSpill r -> let neighbours = Hashtbl.find rig r + in let neighbour_colors = Set.filter_map ( + fun neighbour -> match Hashtbl.find_opt allocation neighbour with + | Some (Reg color) -> Some color + | _ -> None + ) neighbours + in let available_colors = Set.diff all_colors neighbour_colors + in let chosen_color = Set.choose available_colors + in Hashtbl.add allocation r (Reg chosen_color); next_stack_slot (* [regalloc_fun f live_out all_colors] effectue l'allocation de registres pour la fonction [f]. diff --git a/src/rtl_gen.ml b/src/rtl_gen.ml index ce1eb8f84ef214052bb074b76658d460ac7045df..7955b3fe97c68b8cbe7ecdaa4e33811d1d93437e 100644 --- a/src/rtl_gen.ml +++ b/src/rtl_gen.ml @@ -43,7 +43,16 @@ let find_var (next_reg, var2reg) v = - [var2reg] est la nouvelle association nom de variable/registre. *) let rec rtl_instrs_of_cfg_expr (next_reg, var2reg) (e: expr) = - (next_reg, [], next_reg, var2reg) + match e with + | Evar v -> let r, next_reg', var2reg' = find_var (next_reg, var2reg) v in (r, [], next_reg', var2reg') + | Eint i -> (next_reg, [Rconst(next_reg, i)], next_reg+1, var2reg) + | Ebinop (b, e1, e2) -> + let r1, l1, next_reg1, var2reg1 = rtl_instrs_of_cfg_expr (next_reg, var2reg) e1 + in let r2, l2, next_reg2, var2reg2 = rtl_instrs_of_cfg_expr (next_reg1, var2reg1) e2 + in (next_reg2, l1@l2@[Rbinop(b, next_reg2, r1, r2)], next_reg2+1, var2reg2) + | Eunop (u, e) -> + let r, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e + in (next_reg', l@[Runop(u, next_reg', r)], next_reg'+1, var2reg') let is_cmp_op = function Eclt -> Some Rclt @@ -64,8 +73,24 @@ let rtl_cmp_of_cfg_expr (e: expr) = let rtl_instrs_of_cfg_node ((next_reg:int), (var2reg: (string*int) list)) (c: cfg_node) = - (* TODO *) - ([], next_reg, var2reg) + (* TODO *) + match c with + | Cassign (s, e, i) -> + let r_e, l, next_reg1, var2reg1 = rtl_instrs_of_cfg_expr (next_reg, var2reg) e + in let r_s, next_reg2, var2reg2 = find_var (next_reg1, var2reg1) s + in (l@[Rmov(r_s, r_e); Rjmp i], next_reg2, var2reg2) + | Creturn e -> + let r_e, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e + in (l@[Rret r_e], next_reg', var2reg') + | Cprint (e, i) -> + let r_e, l, next_reg', var2reg' = rtl_instrs_of_cfg_expr (next_reg, var2reg) e + in (l@[Rprint r_e; Rjmp i], next_reg', var2reg') + | Ccmp (e, i1, i2) -> + let cmp, e1, e2 = rtl_cmp_of_cfg_expr e + in let r1, l1, next_reg1, var2reg1 = rtl_instrs_of_cfg_expr (next_reg, var2reg) e1 + in let r2, l2, next_reg2, var2reg2 = rtl_instrs_of_cfg_expr (next_reg1, var2reg1) e2 + in (l1@l2@[Rbranch(cmp, r1, r2, i1)]@[Rjmp i2], next_reg2, var2reg2) + | Cnop i -> ([Rjmp i], next_reg, var2reg) let rtl_instrs_of_cfg_fun cfgfunname ({ cfgfunargs; cfgfunbody; cfgentry }: cfg_fun) = let (rargs, next_reg, var2reg) =