Fixing live analysis

This commit is contained in:
elvis
2025-01-16 23:48:23 +01:00
parent cf0bc41a23
commit d78e8bfbe0
9 changed files with 269 additions and 27 deletions

View File

@ -755,10 +755,15 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
} ->
let initial_bindings =
match inputOutputVar with
| Some (i, o) ->
RegisterMap.empty |>
RegisterMap.set_register i {index = "in"} |>
RegisterMap.set_register o {index = "out"}
| Some (i, o) -> (
if i = o then
RegisterMap.empty |>
RegisterMap.set_register i {index = "in"}
else
RegisterMap.empty |>
RegisterMap.set_register i {index = "in"} |>
RegisterMap.set_register o {index = "out"}
)
| None ->
RegisterMap.empty
in
@ -767,7 +772,16 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
edges = edges;
reverseEdges = reverseEdges;
inputVal = inputVal;
inputOutputVar = Some ("in", "out");
inputOutputVar = (
match inputOutputVar with
| Some (i, o) -> (
if i = o then
Some ("in", "in")
else
Some ("in", "out")
)
| None -> Some ("in", "out")
);
initial = initial;
terminal = terminal;
content = helper content initial_bindings;

View File

@ -18,7 +18,9 @@ module DVCfg = Dataflow.Make (CfgRISC.RISCSimpleStatements) (Variable)
module DVCeltSet = Set.Make(Variable)
let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
let variables_used (instr : DVCfg.elt)
: DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop
@ -51,6 +53,33 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
helper DVCeltSet.empty instructions |> DVCeltSet.to_list
let variables (instruction : DVCfg.elt) : DVCfg.internal list =
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop -> acc
| Store (r1, r2) ->
DVCeltSet.add r1.index acc |>
DVCeltSet.add r2.index
| BRegOp (_, r1, r2, r3) ->
DVCeltSet.add r1.index acc |>
DVCeltSet.add r2.index |>
DVCeltSet.add r3.index
| BImmOp (_, r1, _, r3)
| URegOp (_, r1, r3)
| Load (r1, r3) ->
DVCeltSet.add r1.index acc |>
DVCeltSet.add r3.index
| LoadI (_, r3) ->
DVCeltSet.add r3.index acc
in
helper DVCeltSet.empty instruction |> DVCeltSet.to_list
let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
DVCeltSet.union acc (variables instr |> DVCeltSet.of_list)
) DVCeltSet.empty instructions |> DVCeltSet.to_list
(* init function, assign the bottom to everything *)
let init : (DVCfg.elt list -> DVCfg.internalnode) =
(fun l -> {internalin = [];
@ -157,7 +186,7 @@ module VariableMap = struct
let start = "1" in
first_empty next start m l
let get_mapping m l r =
let get_or_set_mapping m l r =
match find_opt r m with
| None -> (
let newr = first_empty_Variable m l in
@ -179,33 +208,33 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(a, Nop)
)
| BRegOp (brop, r1, r2, r3) -> (
let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
let (newa, newr2) = VariableMap.get_mapping newa vin r2.index in
let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
let (newa, newr2) = VariableMap.get_or_set_mapping newa vin r2.index in
let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, BRegOp (brop, {index = newr1}, {index = newr2}, {index = newr3}))
)
| BImmOp (biop, r1, i, r3) -> (
let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, BImmOp (biop, {index = newr1}, i, {index = newr3}))
)
| URegOp (urop, r1, r3) -> (
let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, URegOp (urop, {index = newr1}, {index = newr3}))
)
| Load (r1, r3) -> (
let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, Load ({index = newr1}, {index = newr3}))
)
| LoadI (i, r3) -> (
let (newa, newr3) = VariableMap.get_mapping a vout r3.index in
let (newa, newr3) = VariableMap.get_or_set_mapping a vout r3.index in
(newa, LoadI (i, {index = newr3}))
)
| Store (r1, r3) -> (
let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, Store ({index = newr1}, {index = newr3}))
)
in
@ -228,6 +257,7 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
livevars.internalbetween
code)
in
let newcontent = Cfg.NodeMap.add
node
newcode
@ -240,14 +270,65 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(* ------------------- *)
let assignments = VariableMap.empty in
(* at least the input variable should be in the mapping *)
let assignments =
match t.t.inputOutputVar with
None -> VariableMap.empty
| Some (i, _o) -> (
VariableMap.get_or_set_mapping VariableMap.empty [] i |> fst
)
in
let a, newt =
let all_variables = List.fold_left
(fun acc (_, code) ->
Utility.unique_union acc (variables_all code))
[]
(Cfg.NodeMap.to_list t.t.content)
in
let mapping =
(* for each variable we get the union of all in and out that contains it
then we find a register such that it's not in conflict *)
List.fold_left (fun assignments v -> (
(* union of all in and out such that v is in the set *)
let union : 'a list =
List.fold_left
(fun (acc: 'a list) (node, (x: DVCfg.internalnode)) ->
(* not interested in internalin or internalout since information
is mirrored into internalbetween *)
List.fold_left2
(fun acc (i, o) code ->
(* we also consider the out set if we "use" v as a guard *)
match List.mem v i,
List.mem v o,
List.mem v (variables_defined code) with
| false, false, false -> acc
| true, false, false -> Utility.unique_union i acc
| false, false, true
| false, true, _ -> Utility.unique_union o acc
| true, false, true
| true, true, _ -> Utility.unique_union
(Utility.unique_union i o) acc
)
acc
x.internalbetween
(Cfg.NodeMap.find_opt node t.t.content |>
Option.value ~default:[])
)
[]
(Cfg.NodeMap.to_list t.internalvar)
in
let assignments, _ = VariableMap.get_or_set_mapping assignments union v in
assignments
)) assignments all_variables
in
let mapping, newt =
Cfg.NodeSet.fold (* for each node we replace all the variables with the
optimized ones *)
(fun node (assign, t) -> aux assign t node)
t.t.nodes
(assignments, t)
(mapping, t)
in
{ newt with
@ -256,7 +337,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
match newt.t.inputOutputVar with
None -> None
| Some (i, o) -> (
match VariableMap.find_opt i a, VariableMap.find_opt o a with
match VariableMap.find_opt i mapping,
VariableMap.find_opt o mapping with
| None, None -> Some (i, o)
| Some i, None -> Some (i, o)
| None, Some o -> Some (i, o)