112 lines
4.3 KiB
OCaml
112 lines
4.3 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* OCaml *)
|
|
(* *)
|
|
(* Mark Shinwell, Jane Street Europe *)
|
|
(* *)
|
|
(* Copyright 2016--2017 Jane Street Group LLC *)
|
|
(* *)
|
|
(* 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. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
[@@@ocaml.warning "+a-4-9-30-40-41-42"]
|
|
|
|
module RD = Reg_with_debug_info
|
|
module V = Backend_var
|
|
|
|
type t =
|
|
| Ok of RD.Set.t
|
|
| Unreachable
|
|
|
|
let inter regs1 regs2 =
|
|
match regs1, regs2 with
|
|
| Unreachable, _ -> regs2
|
|
| _, Unreachable -> regs1
|
|
| Ok avail1, Ok avail2 ->
|
|
let result =
|
|
RD.Set.fold (fun reg1 result ->
|
|
match RD.Set.find_reg_exn avail2 (RD.reg reg1) with
|
|
| exception Not_found -> result
|
|
| reg2 ->
|
|
let debug_info1 = RD.debug_info reg1 in
|
|
let debug_info2 = RD.debug_info reg2 in
|
|
let debug_info =
|
|
match debug_info1, debug_info2 with
|
|
| None, None -> None
|
|
(* Example for this next case: the value of a mutable variable x
|
|
is copied into another variable y; then there is a conditional
|
|
where on one branch x is assigned and on the other branch it
|
|
is not. This means that on the former branch we have
|
|
forgotten about y holding the value of x; but we have not on
|
|
the latter. At the join point we must have forgotten the
|
|
information. *)
|
|
| None, Some _ | Some _, None -> None
|
|
| Some debug_info1, Some debug_info2 ->
|
|
if RD.Debug_info.compare debug_info1 debug_info2 = 0 then
|
|
Some debug_info1
|
|
else
|
|
None
|
|
in
|
|
let reg =
|
|
RD.create_with_debug_info ~reg:(RD.reg reg1)
|
|
~debug_info
|
|
in
|
|
RD.Set.add reg result)
|
|
avail1
|
|
RD.Set.empty
|
|
in
|
|
Ok result
|
|
|
|
let equal t1 t2 =
|
|
match t1, t2 with
|
|
| Unreachable, Unreachable -> true
|
|
| Unreachable, Ok _ | Ok _, Unreachable -> false
|
|
| Ok regs1, Ok regs2 -> RD.Set.equal regs1 regs2
|
|
|
|
let canonicalise availability =
|
|
match availability with
|
|
| Unreachable -> Unreachable
|
|
| Ok availability ->
|
|
let regs_by_ident = V.Tbl.create 42 in
|
|
RD.Set.iter (fun reg ->
|
|
match RD.debug_info reg with
|
|
| None -> ()
|
|
| Some debug_info ->
|
|
let name = RD.Debug_info.holds_value_of debug_info in
|
|
if not (V.persistent name) then begin
|
|
match V.Tbl.find regs_by_ident name with
|
|
| exception Not_found -> V.Tbl.add regs_by_ident name reg
|
|
| (reg' : RD.t) ->
|
|
(* We prefer registers that are assigned to the stack since
|
|
they probably give longer available ranges (less likely to
|
|
be clobbered). *)
|
|
match RD.location reg, RD.location reg' with
|
|
| Reg _, Stack _
|
|
| Reg _, Reg _
|
|
| Stack _, Stack _
|
|
| _, Unknown
|
|
| Unknown, _ -> ()
|
|
| Stack _, Reg _ ->
|
|
V.Tbl.remove regs_by_ident name;
|
|
V.Tbl.add regs_by_ident name reg
|
|
end)
|
|
availability;
|
|
let result =
|
|
V.Tbl.fold (fun _ident reg availability ->
|
|
RD.Set.add reg availability)
|
|
regs_by_ident
|
|
RD.Set.empty
|
|
in
|
|
Ok result
|
|
|
|
let print ~print_reg ppf = function
|
|
| Unreachable -> Format.fprintf ppf "<unreachable>"
|
|
| Ok availability ->
|
|
Format.fprintf ppf "{%a}"
|
|
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
|
|
(Reg_with_debug_info.print ~print_reg))
|
|
(RD.Set.elements availability)
|