TP6 regalloc OK

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_interf rig x y] ajoute [y] à la liste des registres 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,22 @@ 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 *)
-    ()
+    begin
+    match Hashtbl.find_option rig x with 
+    | Some xset -> 
+      Hashtbl.modify_def Set.empty x (fun set-> Set.union set (Set.singleton(y))) rig;
+      begin
+      match Hashtbl.find_option rig y with 
+      | Some yset -> Hashtbl.modify_def Set.empty y (fun set -> Set.union set (Set.singleton(x))) rig
+      | None -> Hashtbl.add rig y (Set.singleton x)
+      end
+    | None -> Hashtbl.add rig x (Set.singleton y);
+    begin
+      match Hashtbl.find_option rig y with 
+      | Some yset -> Hashtbl.modify_def Set.empty y (fun set -> Set.union set (Set.singleton(x))) rig
+      | None -> Hashtbl.add rig y (Set.singleton x)
+    end
+    end
 
 
 (* [make_interf_live rig live] ajoute des arcs dans le graphe d'interférence
@@ -89,7 +104,12 @@ let make_interf_live
     (rig: (reg, reg Set.t) Hashtbl.t)
     (live : (int, reg Set.t) Hashtbl.t) : unit =
     (* TODO *)
-   ()
+    Hashtbl.iter (fun node set_of_regliving -> 
+      Set.iter (fun reg1 -> 
+        Set.iter (fun reg2 -> 
+          add_interf rig reg1 reg2 ) (Set.diff set_of_regliving (Set.singleton reg1))
+          ) set_of_regliving
+          ) 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
@@ -121,7 +141,8 @@ let build_interference_graph (live_out : (int, reg Set.t) Hashtbl.t) code : (reg
    [rig]. *)
 let remove_from_rig (rig : (reg, reg Set.t) Hashtbl.t)  (v: reg) : unit =
    (* TODO *)
-   ()
+   Hashtbl.remove rig v;
+   Hashtbl.iter (fun key keyset -> Hashtbl.replace rig key (Set.remove v keyset)) rig;
 
 
 (* Type représentant les différentes décisions qui peuvent être prises par
@@ -160,7 +181,10 @@ type regalloc_decision =
    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
+   Hashtbl.fold (fun k d acc -> 
+    if (Set.cardinal d) < n then Some k
+    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.
@@ -172,14 +196,27 @@ let pick_node_with_fewer_than_n_neighbors (rig : (reg, reg Set.t) Hashtbl.t) (n:
    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
+   Hashtbl.to_list rig
+   |> List.map (fun (reg ,regset) -> (reg,Set.cardinal regset))
+   |> List.sort (fun (reg1,card1) (reg2,card2) -> card2 - card1)
+   |> fun list_sorted -> List.nth_opt list_sorted 0 
+   |> Option.map fst
 
 (* [make_stack rig stack ncolors] construit la pile, selon l'algorithme vu en
    cours (slides 60 à 63 du cours "Allocation de registres - Autres slides"
    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
+   begin
+    match pick_node_with_fewer_than_n_neighbors rig ncolors with
+    | Some node -> remove_from_rig rig node;
+     make_stack rig (NoSpill node :: stack) ncolors
+     | None -> (
+        match pick_spilling_candidate rig with
+        | Some node_to_spill -> remove_from_rig rig node_to_spill;
+        make_stack rig (Spill node_to_spill :: stack) ncolors
+        | None -> stack)
+      end
 
 (* 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
@@ -219,7 +256,26 @@ let allocate (allocation: (reg, loc) Hashtbl.t) (rig: (reg, reg Set.t) Hashtbl.t
     (next_stack_slot: int) (decision: regalloc_decision)
   : int =
    (* TODO *)
-   next_stack_slot
+   match decision with
+   | Spill r -> Hashtbl.add allocation r (Stk(next_stack_slot))  ; next_stack_slot - 1
+   | NoSpill r -> 
+    let set__of__neightbours = 
+      match Hashtbl.find_option rig r with 
+    | Some a -> a
+    | None -> Set.empty 
+  in
+    let colours_used = Set.fold (fun neightbour acc -> 
+      match Hashtbl.find_option allocation neightbour with
+      | Some i -> 
+        begin
+        match i with 
+        | Reg colour -> Set.union acc (Set.singleton colour)
+        | Stk shift -> acc
+        end
+      | None -> acc ) set__of__neightbours Set.empty
+    in
+    let colours_usable = Set.diff all_colors colours_used in
+    Hashtbl.add allocation r (Reg(Set.choose colours_usable)) ; next_stack_slot
 
 (* [regalloc_fun f live_out all_colors] effectue l'allocation de registres pour
    la fonction [f].