146 lines
4.6 KiB
OCaml
146 lines
4.6 KiB
OCaml
open Analysis
|
|
|
|
module Variable = struct
|
|
type t = string
|
|
let pp (ppf: out_channel) (v: t) : unit =
|
|
Printf.fprintf ppf "%s" v
|
|
|
|
let pplist (ppf: out_channel) (vv: t list) : unit =
|
|
List.iter (Printf.fprintf ppf "%s, ") vv
|
|
|
|
let compare a b =
|
|
String.compare a b
|
|
end
|
|
|
|
module RISCCfg = CfgRISC.RISCCfg
|
|
|
|
module DVCfg = Dataflow.Make (CfgRISC.RISCSimpleStatements) (Variable)
|
|
module DVCeltSet = Set.Make(Variable)
|
|
|
|
|
|
let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
|
|
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
|
match instr with
|
|
| Nop
|
|
| LoadI (_, _) ->
|
|
acc
|
|
| BRegOp (_, r1, r2, _) ->
|
|
DVCeltSet.add r1.index acc |>
|
|
DVCeltSet.add r2.index
|
|
| BImmOp (_, r1, _, _)
|
|
| URegOp (_, r1, _)
|
|
| Load (r1, _)
|
|
| Store (r1, _) ->
|
|
DVCeltSet.add r1.index acc
|
|
in
|
|
|
|
helper DVCeltSet.empty instr |> DVCeltSet.to_list
|
|
|
|
let _variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list =
|
|
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
|
|
DVCeltSet.union acc (variables_used instr |> DVCeltSet.of_list)
|
|
) DVCeltSet.empty instructions |> DVCeltSet.to_list
|
|
|
|
|
|
let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
|
|
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
|
match instr with
|
|
| Nop -> acc
|
|
| BRegOp (_, _, _, r3)
|
|
| BImmOp (_, _, _, r3)
|
|
| URegOp (_, _, r3)
|
|
| Load (_, r3)
|
|
| LoadI (_, r3)
|
|
| Store (_, r3) ->
|
|
DVCeltSet.add r3.index acc
|
|
in
|
|
|
|
helper DVCeltSet.empty instructions |> DVCeltSet.to_list
|
|
|
|
let _variables_defined_all (instructions : DVCfg.elt list) : DVCfg.internal list =
|
|
List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
|
|
DVCeltSet.union acc (variables_defined 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 = [];
|
|
internalout = [];
|
|
internalbetween = (List.init (List.length l) (fun _ -> ([], [])))})
|
|
|
|
let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
|
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
|
|
let code = match Cfg.NodeMap.find_opt node t.t.content with
|
|
None -> []
|
|
| Some c -> c
|
|
in
|
|
{ previnternalvar with
|
|
internalbetween =
|
|
List.map (fun (prevbtw, code, nextprevbtw) ->
|
|
let newin = Utility.unique_union (variables_used code)
|
|
(Utility.subtraction (snd prevbtw) (variables_defined code))
|
|
in
|
|
match nextprevbtw with
|
|
None -> (newin, snd prevbtw)
|
|
| Some (newout, _) -> (newin, newout)
|
|
)
|
|
(Utility.combine_thrice previnternalvar.internalbetween code
|
|
(Utility.pad (List.tl previnternalvar.internalbetween) None (List.length previnternalvar.internalbetween)))
|
|
;
|
|
internalin = fst (List.hd previnternalvar.internalbetween);
|
|
}
|
|
|
|
let lucf (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
|
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
|
|
if Option.equal (=) (Some node) t.t.terminal then
|
|
let outputvarlist = match t.t.inputOutputVar with
|
|
Some (_, o) -> [o]
|
|
| None -> []
|
|
in
|
|
{ previnternalvar with
|
|
internalout = outputvarlist;
|
|
internalbetween = (
|
|
let last_elem = Utility.last_list previnternalvar.internalbetween in
|
|
(Utility.drop_last_element_list previnternalvar.internalbetween) @
|
|
[(fst last_elem, outputvarlist)]
|
|
)
|
|
}
|
|
else
|
|
let nextnodes = Cfg.NodeMap.find_opt node t.t.edges in
|
|
let newinternalout = match nextnodes with
|
|
None -> []
|
|
| Some (node, None) -> (Cfg.NodeMap.find node t.internalvar).internalin
|
|
| Some (node1, Some node2) ->
|
|
Utility.unique_union
|
|
(Cfg.NodeMap.find node1 t.internalvar).internalin
|
|
(Cfg.NodeMap.find node2 t.internalvar).internalin
|
|
in
|
|
{ previnternalvar with
|
|
internalout = newinternalout;
|
|
internalbetween = (
|
|
let last_elem = Utility.last_list previnternalvar.internalbetween in
|
|
(Utility.drop_last_element_list previnternalvar.internalbetween) @
|
|
[(fst last_elem, newinternalout)]
|
|
)
|
|
}
|
|
|
|
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
|
let newt = {t with internalvar = (Cfg.NodeMap.add node (lucf t node) t.internalvar)} in
|
|
lub newt node
|
|
|
|
|
|
let compute_live_variables (cfg: RISCCfg.t) : DVCfg.t =
|
|
DVCfg.from_cfg cfg
|
|
|> DVCfg.fixed_point ~init:init ~update:update
|
|
|
|
|
|
(* just rename the registers that dont share live status *)
|
|
let optimize_cfg (t: DVCfg.t) : DVCfg.t =
|
|
t
|
|
|
|
|
|
|
|
let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t =
|
|
DVCfg.to_cfg dvcfg
|