(**************************************************************************) (* *) (* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Cmm module V = Backend_var module Raw_name = struct type t = | Anon | R | Var of V.t let create_from_var var = Var var let to_string t = match t with | Anon -> None | R -> Some "R" | Var var -> let name = V.name var in if String.length name <= 0 then None else Some name end type t = { mutable raw_name: Raw_name.t; stamp: int; typ: Cmm.machtype_component; mutable loc: location; mutable spill: bool; mutable part: int option; mutable interf: t list; mutable prefer: (t * int) list; mutable degree: int; mutable spill_cost: int; mutable visited: int } and location = Unknown | Reg of int | Stack of stack_location and stack_location = Local of int | Incoming of int | Outgoing of int type reg = t let dummy = { raw_name = Raw_name.Anon; stamp = 0; typ = Int; loc = Unknown; spill = false; interf = []; prefer = []; degree = 0; spill_cost = 0; visited = 0; part = None; } let currstamp = ref 0 let reg_list = ref([] : t list) let hw_reg_list = ref ([] : t list) let visit_generation = ref 1 (* Any visited value not equal to !visit_generation counts as "unvisited" *) let unvisited = 0 let mark_visited r = r.visited <- !visit_generation let is_visited r = r.visited = !visit_generation let clear_visited_marks () = incr visit_generation let create ty = let r = { raw_name = Raw_name.Anon; stamp = !currstamp; typ = ty; loc = Unknown; spill = false; interf = []; prefer = []; degree = 0; spill_cost = 0; visited = unvisited; part = None; } in reg_list := r :: !reg_list; incr currstamp; r let createv tyv = let n = Array.length tyv in let rv = Array.make n dummy in for i = 0 to n-1 do rv.(i) <- create tyv.(i) done; rv let createv_like rv = let n = Array.length rv in let rv' = Array.make n dummy in for i = 0 to n-1 do rv'.(i) <- create rv.(i).typ done; rv' let clone r = let nr = create r.typ in nr.raw_name <- r.raw_name; nr let at_location ty loc = let r = { raw_name = Raw_name.R; stamp = !currstamp; typ = ty; loc; spill = false; interf = []; prefer = []; degree = 0; spill_cost = 0; visited = unvisited; part = None; } in hw_reg_list := r :: !hw_reg_list; incr currstamp; r let typv rv = Array.map (fun r -> r.typ) rv let anonymous t = match Raw_name.to_string t.raw_name with | None -> true | Some _raw_name -> false let name t = match Raw_name.to_string t.raw_name with | None -> "" | Some raw_name -> let with_spilled = if t.spill then "spilled-" ^ raw_name else raw_name in match t.part with | None -> with_spilled | Some part -> with_spilled ^ "#" ^ Int.to_string part let first_virtual_reg_stamp = ref (-1) let reset() = (* When reset() is called for the first time, the current stamp reflects all hard pseudo-registers that have been allocated by Proc, so remember it and use it as the base stamp for allocating soft pseudo-registers *) if !first_virtual_reg_stamp = -1 then begin first_virtual_reg_stamp := !currstamp; assert (!reg_list = []) (* Only hard regs created before now *) end; currstamp := !first_virtual_reg_stamp; reg_list := []; visit_generation := 1; !hw_reg_list |> List.iter (fun r -> r.visited <- unvisited) let all_registers() = !reg_list let num_registers() = !currstamp let reinit_reg r = r.loc <- Unknown; r.interf <- []; r.prefer <- []; r.degree <- 0; (* Preserve the very high spill costs introduced by the reloading pass *) if r.spill_cost >= 100000 then r.spill_cost <- 100000 else r.spill_cost <- 0 let reinit() = List.iter reinit_reg !reg_list module RegOrder = struct type t = reg let compare r1 r2 = r1.stamp - r2.stamp end module Set = Set.Make(RegOrder) module Map = Map.Make(RegOrder) let add_set_array s v = match Array.length v with 0 -> s | 1 -> Set.add v.(0) s | n -> let rec add_all i = if i >= n then s else Set.add v.(i) (add_all(i+1)) in add_all 0 let diff_set_array s v = match Array.length v with 0 -> s | 1 -> Set.remove v.(0) s | n -> let rec remove_all i = if i >= n then s else Set.remove v.(i) (remove_all(i+1)) in remove_all 0 let inter_set_array s v = match Array.length v with 0 -> Set.empty | 1 -> if Set.mem v.(0) s then Set.add v.(0) Set.empty else Set.empty | n -> let rec inter_all i = if i >= n then Set.empty else if Set.mem v.(i) s then Set.add v.(i) (inter_all(i+1)) else inter_all(i+1) in inter_all 0 let disjoint_set_array s v = match Array.length v with 0 -> true | 1 -> not (Set.mem v.(0) s) | n -> let rec disjoint_all i = if i >= n then true else if Set.mem v.(i) s then false else disjoint_all (i+1) in disjoint_all 0 let set_of_array v = match Array.length v with 0 -> Set.empty | 1 -> Set.add v.(0) Set.empty | n -> let rec add_all i = if i >= n then Set.empty else Set.add v.(i) (add_all(i+1)) in add_all 0