Live Variables

lib/miniImp/liveVariables.ml

@@ -0,0 +1,145 @@
+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