Fixes defined variables, fixes live variables, implements reduces registers, fixes risc semantic
This commit is contained in:
elvis
@ -33,6 +33,16 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
|
||||
internalbetween: (internal list * internal list) list;
|
||||
}
|
||||
|
||||
let compareinternalnode (a:internalnode) (b:internalnode) : bool =
|
||||
match Utility.equality a.internalin b.internalin,
|
||||
Utility.equality a.internalout b.internalout,
|
||||
(List.fold_left2 (fun acc (ain, aout) (bin, bout)
|
||||
-> acc && (Utility.equality ain bin) && (Utility.equality aout bout)
|
||||
) true a.internalbetween b.internalbetween)
|
||||
with
|
||||
| true, true, true -> true
|
||||
| _, _, _ -> false
|
||||
|
||||
type cfgt = elt Cfg.cfginternal
|
||||
|
||||
type t = {
|
||||
@ -40,49 +50,23 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
|
||||
internalvar: internalnode Cfg.NodeMap.t;
|
||||
}
|
||||
|
||||
let compareinternal (a: internalnode Cfg.NodeMap.t) (b: internalnode Cfg.NodeMap.t) =
|
||||
Cfg.NodeMap.fold
|
||||
(fun node bi acc ->
|
||||
match Cfg.NodeMap.find_opt node a with
|
||||
None -> false
|
||||
| Some ai -> acc && compareinternalnode ai bi
|
||||
) b true
|
||||
|
||||
let from_cfg (cfg: cfgt) : t =
|
||||
{t = cfg; internalvar = Cfg.NodeMap.empty}
|
||||
|
||||
let to_cfg ({t; _}: t) : cfgt =
|
||||
t
|
||||
|
||||
let fixed_point
|
||||
?(init : (elt list -> internalnode) =
|
||||
(fun _ -> {internalin = []; internalout = []; internalbetween = []}))
|
||||
?(update : (t -> Cfg.Node.t -> internalnode) =
|
||||
(fun t n -> Cfg.NodeMap.find n t.internalvar))
|
||||
(t: t)
|
||||
: t =
|
||||
(* init function is applied only once to each node content,
|
||||
the update function takes the node and the whole structure and is
|
||||
expected to return the updated structure for the appropriate node,
|
||||
update function is applied to the resulting structure until no change is
|
||||
observed
|
||||
*)
|
||||
let rec helper t =
|
||||
let newt =
|
||||
{t with
|
||||
internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar}
|
||||
in
|
||||
if newt = t then newt else helper newt
|
||||
in
|
||||
let content = List.fold_left
|
||||
(fun cfg node -> Cfg.NodeMap.add node {internalin = [];
|
||||
internalout = [];
|
||||
internalbetween = []} cfg)
|
||||
Cfg.NodeMap.empty
|
||||
(Cfg.NodeSet.to_list t.t.nodes)
|
||||
in
|
||||
let content = Cfg.NodeMap.union
|
||||
(fun _ket _empty code -> Some code)
|
||||
content
|
||||
(Cfg.NodeMap.map init t.t.content)
|
||||
in
|
||||
helper { t with internalvar = content }
|
||||
|
||||
|
||||
open Cfg
|
||||
let pp (ppf: out_channel) (c: t) : unit =
|
||||
let pp (ppf: out_channel) (c: t) : unit = (
|
||||
Printf.fprintf ppf "Cfg:\n";
|
||||
Printf.fprintf ppf "Nodes' ids: ";
|
||||
List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.t.nodes);
|
||||
@ -148,4 +132,54 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct
|
||||
Printf.fprintf ppf "\n";
|
||||
) (NodeMap.to_list c.internalvar);
|
||||
Printf.fprintf ppf "\n";
|
||||
)
|
||||
|
||||
|
||||
let fixed_point
|
||||
?(init : (elt list -> internalnode) =
|
||||
(fun _ -> {internalin = []; internalout = []; internalbetween = []}))
|
||||
?(update : (t -> Cfg.Node.t -> internalnode) =
|
||||
(fun t n -> Cfg.NodeMap.find n t.internalvar))
|
||||
(t: t)
|
||||
: t =
|
||||
(* init function is applied only once to each node content,
|
||||
the update function takes the node and the whole structure and is
|
||||
expected to return the updated structure for the appropriate node,
|
||||
update function is applied to the resulting structure until no change is
|
||||
observed
|
||||
*)
|
||||
let rec helper t =
|
||||
let newt =
|
||||
{t with
|
||||
internalvar = Cfg.NodeMap.mapi (fun n _ -> update t n) t.internalvar}
|
||||
in
|
||||
if compareinternal newt.internalvar t.internalvar
|
||||
then newt
|
||||
else helper newt
|
||||
in
|
||||
|
||||
let content =
|
||||
List.fold_left
|
||||
(fun cfg node -> Cfg.NodeMap.add node {internalin = [];
|
||||
internalout = [];
|
||||
internalbetween = []} cfg)
|
||||
Cfg.NodeMap.empty
|
||||
(Cfg.NodeSet.to_list t.t.nodes)
|
||||
in
|
||||
|
||||
let code = (* we add back in the nodes with no code (there is no binding
|
||||
in the t.t.content map) *)
|
||||
Cfg.NodeMap.union (fun _n c _empty -> Some c)
|
||||
t.t.content
|
||||
(Cfg.NodeMap.of_list
|
||||
(Cfg.NodeSet.to_list t.t.nodes |> List.map (fun c -> (c, []))))
|
||||
in
|
||||
|
||||
let content = Cfg.NodeMap.union
|
||||
(fun _key _empty code -> Some code)
|
||||
content
|
||||
(Cfg.NodeMap.map init code)
|
||||
in
|
||||
helper { t with internalvar = content }
|
||||
|
||||
end
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
(library
|
||||
(name analysis)
|
||||
(public_name analysis)
|
||||
(modules Cfg Dataflow))
|
||||
(modules Cfg Dataflow)
|
||||
(libraries utility))
|
||||
|
||||
(include_subdirs qualified)
|
||||
|
||||
@ -59,7 +59,8 @@ module RISCAssembly = struct
|
||||
|
||||
type t = {
|
||||
code : risci list;
|
||||
inputval: int option
|
||||
inputval: int option;
|
||||
inputoutputreg: (register * register) option;
|
||||
}
|
||||
|
||||
let pp_risci (ppf: out_channel) (v: risci) : unit =
|
||||
@ -285,4 +286,9 @@ let rec helper
|
||||
let convert (prg: CfgRISC.RISCCfg.t) : RISCAssembly.t =
|
||||
{code = (helper prg (Option.get prg.initial) [] |> fst |>
|
||||
List.append ([Label "main"] : RISCAssembly.risci list));
|
||||
inputval = prg.inputVal}
|
||||
inputval = prg.inputVal;
|
||||
inputoutputreg =
|
||||
match prg.inputOutputVar with
|
||||
None -> None
|
||||
| Some (i, o) -> Some ({index = i}, {index = o})
|
||||
}
|
||||
|
||||
@ -50,7 +50,8 @@ module RISCAssembly : sig
|
||||
|
||||
type t = {
|
||||
code : risci list;
|
||||
inputval: int option
|
||||
inputval: int option;
|
||||
inputoutputreg: (register * register) option;
|
||||
}
|
||||
|
||||
val pp_risci : out_channel -> risci -> unit
|
||||
|
||||
@ -13,7 +13,8 @@ module RISCArchitecture = struct
|
||||
type t = {
|
||||
code: RISC.RISCAssembly.risci list CodeMap.t;
|
||||
registers: int RegisterMap.t;
|
||||
memory: int MemoryMap.t
|
||||
memory: int MemoryMap.t;
|
||||
outputreg: Register.t;
|
||||
}
|
||||
end
|
||||
|
||||
@ -101,7 +102,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
else
|
||||
prg
|
||||
)
|
||||
| Nop :: tl -> helper prg tl current_label
|
||||
| Nop :: tl ->
|
||||
helper prg tl current_label
|
||||
| BRegOp (brop, r1, r2, r3) :: tl -> (
|
||||
let n = (match_operator_r brop)
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
@ -136,7 +138,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
)
|
||||
)
|
||||
| Load (r1, r3) :: tl -> (
|
||||
let n = MemoryMap.find
|
||||
let n =
|
||||
MemoryMap.find
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
prg.memory
|
||||
in
|
||||
@ -164,14 +167,29 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
| Label _ :: tl -> helper prg tl current_label
|
||||
in
|
||||
RegisterMap.find
|
||||
{index = "out"}
|
||||
prg.outputreg
|
||||
(helper prg (CodeMap.find "main" prg.code) "main").registers
|
||||
|
||||
|
||||
let reduce (prg: RISC.RISCAssembly.t) : int =
|
||||
reduce_instructions {code = convert prg;
|
||||
registers =
|
||||
RegisterMap.singleton
|
||||
{index = "in"}
|
||||
(Option.value prg.inputval ~default:0);
|
||||
memory = MemoryMap.empty} (label_order prg)
|
||||
reduce_instructions
|
||||
{code = convert prg;
|
||||
registers = (
|
||||
match prg.inputoutputreg with
|
||||
| None ->
|
||||
RegisterMap.singleton
|
||||
{index = "in"}
|
||||
(Option.value prg.inputval ~default:0)
|
||||
| Some (i, _) ->
|
||||
RegisterMap.singleton
|
||||
{index = i.index}
|
||||
(Option.value prg.inputval ~default:0)
|
||||
);
|
||||
memory = MemoryMap.empty;
|
||||
outputreg = (
|
||||
match prg.inputoutputreg with
|
||||
| None -> {index = "out"}
|
||||
| Some (_, o) -> {index = o.index}
|
||||
)
|
||||
}
|
||||
(label_order prg)
|
||||
|
||||
@ -50,13 +50,13 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
|
||||
| Nop
|
||||
| LoadI (_, _) ->
|
||||
acc
|
||||
| Store (r1, r2)
|
||||
| BRegOp (_, r1, r2, _) ->
|
||||
DVCeltSet.add r1.index acc |>
|
||||
DVCeltSet.add r2.index
|
||||
| BImmOp (_, r1, _, _)
|
||||
| URegOp (_, r1, _)
|
||||
| Load (r1, _)
|
||||
| Store (r1, _) ->
|
||||
| Load (r1, _) ->
|
||||
DVCeltSet.add r1.index acc
|
||||
in
|
||||
|
||||
@ -71,24 +71,18 @@ let variables_used_all (instructions : DVCfg.elt list) : DVCfg.internal list =
|
||||
let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
|
||||
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
|
||||
match instr with
|
||||
| Nop -> acc
|
||||
| Nop
|
||||
| Store (_, _) -> acc
|
||||
| BRegOp (_, _, _, r3)
|
||||
| BImmOp (_, _, _, r3)
|
||||
| URegOp (_, _, r3)
|
||||
| Load (_, r3)
|
||||
| LoadI (_, r3)
|
||||
| Store (_, r3) ->
|
||||
| LoadI (_, 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_bottom : (DVCfg.elt list -> DVCfg.internalnode) =
|
||||
@ -104,91 +98,91 @@ let init_top (all_variables) : (DVCfg.elt list -> DVCfg.internalnode) =
|
||||
(fun _ -> (all_variables, all_variables)))})
|
||||
|
||||
|
||||
(* piece of code that computes vout for the whole block, not used,
|
||||
use lub below *)
|
||||
let _dumb_lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
let previnternalvar = Cfg.NodeMap.find node t.internalvar in
|
||||
let code = Cfg.NodeMap.find node t.t.content in
|
||||
{ previnternalvar with
|
||||
internalout =
|
||||
Utility.unique_union (variables_defined_all code) (previnternalvar.internalin)
|
||||
}
|
||||
|
||||
|
||||
(* We consider only the propagation in the middle elements during the lub.
|
||||
This incurs in a performance penality, but it is simpler to implement.
|
||||
Each node is connected to one previus node.
|
||||
*)
|
||||
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
|
||||
|
||||
let newinternalbetween = (
|
||||
List.map
|
||||
(fun (code, (i, _o)) ->
|
||||
(i, Utility.unique_union i (variables_defined code)))
|
||||
(List.combine code previnternalvar.internalbetween)
|
||||
) in
|
||||
|
||||
let newinternalout =
|
||||
match newinternalbetween with
|
||||
| [] -> previnternalvar.internalin
|
||||
| _ -> (snd (Utility.last_list newinternalbetween))
|
||||
in
|
||||
|
||||
{ previnternalvar with
|
||||
internalbetween =
|
||||
List.mapi (* we don't NEED the index but i = 0 is easier to write than
|
||||
to check if vinout is None *)
|
||||
(fun i (ithcode, vinout, ithcodeprev) ->
|
||||
if i = 0 then
|
||||
let dvin = previnternalvar.internalin in
|
||||
(dvin, Utility.unique_union dvin (variables_defined ithcode))
|
||||
else (
|
||||
let ithcodeprev = match ithcodeprev with
|
||||
None -> ([], [])
|
||||
| Some x -> x
|
||||
in
|
||||
match vinout with
|
||||
None ->
|
||||
([], variables_defined ithcode)
|
||||
| Some prevdvbtw ->
|
||||
(snd prevdvbtw,
|
||||
Utility.unique_union
|
||||
(variables_defined ithcode)
|
||||
(ithcodeprev |> fst)
|
||||
))
|
||||
)
|
||||
(* ugly code that zips the three lists that we need to compute each vin
|
||||
and vout for the middle of the code *)
|
||||
(Utility.combine_thrice
|
||||
code
|
||||
(Utility.pad_opt
|
||||
(Utility.prev previnternalvar.internalbetween None) None (List.length code))
|
||||
(Utility.pad previnternalvar.internalbetween None (List.length code))
|
||||
);
|
||||
internalout =
|
||||
match previnternalvar.internalbetween with
|
||||
[] -> previnternalvar.internalin
|
||||
| _ -> (snd (Utility.last_list previnternalvar.internalbetween))
|
||||
}
|
||||
internalbetween = newinternalbetween;
|
||||
internalout = newinternalout }
|
||||
|
||||
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.initial then
|
||||
(* if L is initial set dvin to the "in" register *)
|
||||
let newinternalin = (
|
||||
match t.t.inputOutputVar with
|
||||
Some (i, _) -> [i]
|
||||
| None -> []
|
||||
) in
|
||||
|
||||
let newinternalbetween = ( (* set the dvin of each to the previous dvout *)
|
||||
match previnternalvar.internalbetween with
|
||||
[] -> []
|
||||
| [(_i, o)] -> [(newinternalin, o)]
|
||||
| (_i, o) :: btwrest ->
|
||||
(newinternalin, o) :: (
|
||||
List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o))
|
||||
(Utility.combine_twice btwrest previnternalvar.internalbetween)
|
||||
)
|
||||
) in
|
||||
{ previnternalvar with
|
||||
internalin =
|
||||
match t.t.inputOutputVar with
|
||||
Some (i, _) -> [i]
|
||||
| None -> []
|
||||
}
|
||||
internalin = newinternalin;
|
||||
internalbetween = newinternalbetween }
|
||||
else
|
||||
(* if L is not initial set dvin to the intersection of the previous node's
|
||||
dvouts *)
|
||||
let prevnodes = Cfg.NodeMap.find node t.t.reverseEdges in
|
||||
let newinternalin = (
|
||||
match prevnodes with
|
||||
| [] ->
|
||||
[]
|
||||
| [prevnode] ->
|
||||
(Cfg.NodeMap.find prevnode t.internalvar).internalout
|
||||
| [prevnode1; prevnode2] ->
|
||||
Utility.unique_intersection
|
||||
(Cfg.NodeMap.find prevnode1 t.internalvar).internalout
|
||||
(Cfg.NodeMap.find prevnode2 t.internalvar).internalout
|
||||
| prevnode :: restnodes ->
|
||||
List.fold_left (* intersection of all previous nodes' dvout *)
|
||||
(fun acc prevnode ->
|
||||
Utility.unique_intersection
|
||||
acc
|
||||
(Cfg.NodeMap.find prevnode t.internalvar).internalout)
|
||||
(Cfg.NodeMap.find prevnode t.internalvar).internalout
|
||||
restnodes
|
||||
) in
|
||||
|
||||
let newinternalbetween =
|
||||
match previnternalvar.internalbetween with
|
||||
[] -> []
|
||||
| [(_i, o)] -> [(newinternalin, o)]
|
||||
| (_i, o) :: btwrest ->
|
||||
(newinternalin, o) :: (
|
||||
List.map (fun ((_i, o), (_previ, prevo)) -> (prevo, o))
|
||||
(Utility.combine_twice btwrest previnternalvar.internalbetween)
|
||||
)
|
||||
in
|
||||
{ previnternalvar with
|
||||
internalin =
|
||||
match prevnodes with
|
||||
[] -> []
|
||||
| [prevnode] -> (Cfg.NodeMap.find prevnode t.internalvar).internalout
|
||||
| [prevnode1; prevnode2] ->
|
||||
Utility.unique_intersection
|
||||
(Cfg.NodeMap.find prevnode1 t.internalvar).internalout
|
||||
(Cfg.NodeMap.find prevnode2 t.internalvar).internalout
|
||||
| _ ->
|
||||
List.fold_left (* intersection of all previous nodes' dvout *)
|
||||
(fun acc prevnode ->
|
||||
Utility.unique_intersection acc (Cfg.NodeMap.find prevnode t.internalvar).internalout)
|
||||
[]
|
||||
prevnodes
|
||||
}
|
||||
internalin = newinternalin;
|
||||
internalbetween = newinternalbetween }
|
||||
|
||||
|
||||
let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
@ -198,10 +192,16 @@ let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
|
||||
let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
|
||||
let all_variables = List.fold_left
|
||||
(fun acc (_, code) -> Utility.unique_union acc (variables_all code))
|
||||
(fun acc (_, code) ->
|
||||
Utility.unique_union acc (variables_all code))
|
||||
[]
|
||||
(Cfg.NodeMap.to_list cfg.content)
|
||||
in
|
||||
let all_variables =
|
||||
match cfg.inputOutputVar with
|
||||
| None -> all_variables
|
||||
| Some (i, o) -> Utility.unique_union all_variables [i;o]
|
||||
in
|
||||
DVCfg.from_cfg cfg
|
||||
|> DVCfg.fixed_point ~init:(init_top all_variables) ~update:update
|
||||
|
||||
|
||||
@ -3,6 +3,7 @@ open Analysis
|
||||
module Variable : sig
|
||||
type t
|
||||
val pp : out_channel -> t -> unit
|
||||
val pplist : out_channel -> t list -> unit
|
||||
end
|
||||
|
||||
module RISCCfg = CfgRISC.RISCCfg
|
||||
|
||||
@ -13,6 +13,7 @@
|
||||
(modules Lexer Parser Types Semantics
|
||||
CfgImp ReplacePowerMod
|
||||
CfgRISC DefinedVariables LiveVariables
|
||||
ReduceRegisters
|
||||
RISC RISCSemantics)
|
||||
(libraries analysis utility menhirLib))
|
||||
|
||||
|
||||
@ -24,45 +24,33 @@ let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
|
||||
| Nop
|
||||
| LoadI (_, _) ->
|
||||
acc
|
||||
| BRegOp (_, r1, r2, _) ->
|
||||
| BRegOp (_, r1, r2, _)
|
||||
| Store (r1, r2) ->
|
||||
DVCeltSet.add r1.index acc |>
|
||||
DVCeltSet.add r2.index
|
||||
| BImmOp (_, r1, _, _)
|
||||
| URegOp (_, r1, _)
|
||||
| Load (r1, _)
|
||||
| Store (r1, _) ->
|
||||
| Load (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
|
||||
| Nop
|
||||
| Store (_, _) -> acc
|
||||
| BRegOp (_, _, _, r3)
|
||||
| BImmOp (_, _, _, r3)
|
||||
| URegOp (_, _, r3)
|
||||
| Load (_, r3)
|
||||
| LoadI (_, r3)
|
||||
| Store (_, r3) ->
|
||||
| LoadI (_, 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 = [];
|
||||
@ -75,58 +63,68 @@ let lub (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
None -> []
|
||||
| Some c -> c
|
||||
in
|
||||
|
||||
let newinternalbetween = (
|
||||
List.map
|
||||
(fun (code, (_i, o)) ->
|
||||
(Utility.unique_union
|
||||
(variables_used code)
|
||||
(Utility.subtraction o (variables_defined code)), o))
|
||||
(Utility.combine_twice code previnternalvar.internalbetween)
|
||||
) in
|
||||
|
||||
let newinternalin =
|
||||
match newinternalbetween with
|
||||
| [] -> previnternalvar.internalout
|
||||
| (i, _)::_ -> i
|
||||
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);
|
||||
}
|
||||
internalbetween = newinternalbetween;
|
||||
internalin = newinternalin; }
|
||||
|
||||
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
|
||||
|
||||
let newinternalout = (
|
||||
if Option.equal (=) (Some node) t.t.terminal then (
|
||||
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
|
||||
) else (
|
||||
let nextnodes = Cfg.NodeMap.find_opt node t.t.edges in
|
||||
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)]
|
||||
)
|
||||
}
|
||||
)
|
||||
) in
|
||||
|
||||
let newinternalbetween = (
|
||||
match List.rev previnternalvar.internalbetween with
|
||||
| [] -> []
|
||||
| (i, _o) :: btwrest ->
|
||||
let btwrest = List.rev btwrest in
|
||||
let newbtwrest = List.map2
|
||||
(fun (i, _o) (nexti, _nexto) -> (i, nexti))
|
||||
btwrest
|
||||
(Utility.drop_first_element_list previnternalvar.internalbetween)
|
||||
in
|
||||
newbtwrest @ [(i, newinternalout)]
|
||||
) in
|
||||
|
||||
{ previnternalvar with
|
||||
internalout = newinternalout;
|
||||
internalbetween = newinternalbetween; }
|
||||
|
||||
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
|
||||
let newt = {t with internalvar = (Cfg.NodeMap.add node
|
||||
(lucf t node)
|
||||
t.internalvar)} in
|
||||
lub newt node
|
||||
|
||||
|
||||
@ -135,10 +133,136 @@ let compute_live_variables (cfg: RISCCfg.t) : DVCfg.t =
|
||||
|> DVCfg.fixed_point ~init:init ~update:update
|
||||
|
||||
|
||||
|
||||
module VariableMap = struct
|
||||
include Map.Make(Variable)
|
||||
|
||||
let first_empty next start m l =
|
||||
let bindings =
|
||||
List.fold_left (
|
||||
fun acc x ->
|
||||
match find_opt x m with
|
||||
| None -> acc
|
||||
| Some x -> x :: acc) [] l |> List.sort Variable.compare in
|
||||
|
||||
let rec aux x =
|
||||
if List.mem x bindings
|
||||
then aux (next x)
|
||||
else x
|
||||
in
|
||||
aux start
|
||||
|
||||
let first_empty_Variable m l =
|
||||
let next = fun x -> x |> int_of_string |> (+) 1 |> string_of_int in
|
||||
let start = "1" in
|
||||
first_empty next start m l
|
||||
|
||||
let get_mapping m l r =
|
||||
match find_opt r m with
|
||||
| None -> (
|
||||
let newr = first_empty_Variable m l in
|
||||
let newm = add r newr m in
|
||||
(newm, newr)
|
||||
)
|
||||
| Some r -> (m, r)
|
||||
end
|
||||
|
||||
|
||||
(* just rename the registers that dont share live status *)
|
||||
let optimize_cfg (t: DVCfg.t) : DVCfg.t =
|
||||
t
|
||||
let replace_code ((vin, vout): Variable.t list * Variable.t list)
|
||||
(a: Variable.t VariableMap.t)
|
||||
(code: DVCfg.elt)
|
||||
: (Variable.t VariableMap.t * DVCfg.elt) =
|
||||
match code with
|
||||
| Nop -> (
|
||||
(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
|
||||
(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
|
||||
(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
|
||||
(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
|
||||
(newa, Load ({index = newr1}, {index = newr3}))
|
||||
)
|
||||
| LoadI (i, r3) -> (
|
||||
let (newa, newr3) = VariableMap.get_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
|
||||
(newa, Store ({index = newr1}, {index = newr3}))
|
||||
)
|
||||
in
|
||||
|
||||
let aux (assignments: Variable.t VariableMap.t) (t: DVCfg.t) (node: Cfg.Node.t)
|
||||
: (Variable.t VariableMap.t * DVCfg.t) =
|
||||
let livevars = Cfg.NodeMap.find node t.internalvar in
|
||||
let code =
|
||||
match Cfg.NodeMap.find_opt node t.t.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
in
|
||||
let newcode, newassignments =
|
||||
(List.fold_left2
|
||||
(fun (acc, assignments) btw code ->
|
||||
let na, nc = replace_code btw assignments code in
|
||||
(acc @ [nc], na)
|
||||
)
|
||||
([], assignments)
|
||||
livevars.internalbetween
|
||||
code)
|
||||
in
|
||||
let newcontent = Cfg.NodeMap.add
|
||||
node
|
||||
newcode
|
||||
t.t.content
|
||||
in
|
||||
|
||||
let newt = { t with t = { t.t with content = newcontent } } in
|
||||
(newassignments, newt)
|
||||
in
|
||||
|
||||
(* --------- *)
|
||||
|
||||
let assignments = VariableMap.empty in
|
||||
|
||||
let a, newt =
|
||||
Cfg.NodeSet.fold (* for each node we replace all the variables with the
|
||||
optimized ones *)
|
||||
(fun node (ass, t) -> aux ass t node)
|
||||
t.t.nodes
|
||||
(assignments, t)
|
||||
in
|
||||
|
||||
{ newt with
|
||||
t = { newt.t with
|
||||
inputOutputVar =
|
||||
match newt.t.inputOutputVar with
|
||||
None -> None
|
||||
| Some (i, o) -> (
|
||||
match VariableMap.find_opt i a, VariableMap.find_opt o a with
|
||||
| None, None -> Some (i, o)
|
||||
| Some i, None -> Some (i, o)
|
||||
| None, Some o -> Some (i, o)
|
||||
| Some i, Some o -> Some (i, o)
|
||||
)
|
||||
}}
|
||||
|
||||
|
||||
let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t =
|
||||
|
||||
416
lib/miniImp/reduceRegisters.ml
Normal file
416
lib/miniImp/reduceRegisters.ml
Normal file
@ -0,0 +1,416 @@
|
||||
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 VariableMap = Map.Make(Variable)
|
||||
|
||||
let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
|
||||
let add_one = (fun x -> match x with None -> Some 1 | Some x -> Some (x + 1)) in
|
||||
|
||||
let helper (acc: int VariableMap.t) (instr: RISCCfg.elt) =
|
||||
match instr with
|
||||
| Nop ->
|
||||
acc
|
||||
| BRegOp (_, r1, r2, r3) ->
|
||||
VariableMap.update r1.index add_one acc |>
|
||||
VariableMap.update r2.index add_one |>
|
||||
VariableMap.update r3.index add_one
|
||||
| BImmOp (_, r1, _, r3)
|
||||
| URegOp (_, r1, r3)
|
||||
| Load (r1, r3)
|
||||
| Store (r1, r3) ->
|
||||
VariableMap.update r1.index add_one acc |>
|
||||
VariableMap.update r3.index add_one
|
||||
| LoadI (_, r3) ->
|
||||
VariableMap.update r3.index add_one acc
|
||||
in
|
||||
|
||||
helper VariableMap.empty instr |> VariableMap.to_list
|
||||
|
||||
let variables_all_frequency (instructions : RISCCfg.elt list) : (Variable.t * int) list =
|
||||
List.fold_left (fun (acc: int VariableMap.t) (instr: RISCCfg.elt) ->
|
||||
VariableMap.union (fun _v x y -> Some (x + y)) acc (variables_frequency instr |> VariableMap.of_list)
|
||||
) VariableMap.empty instructions |> VariableMap.to_list
|
||||
|
||||
|
||||
let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
(if n < 4 then (failwith "ReduceRegisters: number of registers too small") else ());
|
||||
|
||||
(* we get all the variables with associated frequency (only syntactic use) *)
|
||||
let all_variables = List.fold_left
|
||||
(fun acc (_, code) ->
|
||||
Utility.unique_union acc (variables_all_frequency code))
|
||||
[]
|
||||
(Cfg.NodeMap.to_list cfg.content)
|
||||
in
|
||||
let all_variables =
|
||||
match cfg.inputOutputVar with
|
||||
| None -> all_variables
|
||||
| Some (i, _o) -> (
|
||||
match List.assoc_opt i all_variables with
|
||||
| None -> (i, 1) :: all_variables
|
||||
| Some f -> (i, f+1) :: (List.remove_assoc i all_variables)
|
||||
)
|
||||
in
|
||||
let all_variables =
|
||||
match cfg.inputOutputVar with
|
||||
| None -> all_variables
|
||||
| Some (_i, o) -> (
|
||||
match List.assoc_opt o all_variables with
|
||||
| None -> (o, 1) :: all_variables
|
||||
| Some f -> (o, f+1) :: (List.remove_assoc o all_variables)
|
||||
)
|
||||
in
|
||||
|
||||
let replaceregisters
|
||||
(remappedregisters: Variable.t VariableMap.t)
|
||||
(memorymap: int VariableMap.t)
|
||||
(temporaryregisters: Variable.t list)
|
||||
(code: RISCCfg.elt list)
|
||||
: RISCCfg.elt list =
|
||||
|
||||
let tmpreg1: CfgRISC.RISCSimpleStatements.register =
|
||||
{index = List.nth temporaryregisters 0} in
|
||||
let tmpreg2: CfgRISC.RISCSimpleStatements.register =
|
||||
{index = List.nth temporaryregisters 1} in
|
||||
|
||||
let aux (instruction: RISCCfg.elt) : RISCCfg.elt list =
|
||||
match instruction with
|
||||
| Nop -> [Nop]
|
||||
| BRegOp (brop, r1, r2, r3) -> (
|
||||
match ( VariableMap.find_opt r1.index remappedregisters,
|
||||
VariableMap.find_opt r2.index remappedregisters,
|
||||
VariableMap.find_opt r3.index remappedregisters,
|
||||
VariableMap.find_opt r1.index memorymap,
|
||||
VariableMap.find_opt r1.index memorymap,
|
||||
VariableMap.find_opt r3.index memorymap )
|
||||
with
|
||||
| Some r1, Some r2, Some r3, _, _, _ ->
|
||||
[BRegOp (brop, {index = r1}, {index = r2}, {index = r3})]
|
||||
| Some r1, Some r2, None, _, _, Some m3 ->
|
||||
[BRegOp (brop, {index = r1}, {index = r2}, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| Some r1, None, Some r3, _, Some m2, _ ->
|
||||
[LoadI (m2, tmpreg2);
|
||||
Load (tmpreg2, tmpreg2);
|
||||
BRegOp (brop, {index = r1}, tmpreg2, {index = r3})]
|
||||
| None, Some r2, Some r3, Some m1, _, _ ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
BRegOp (brop, tmpreg1, {index = r2}, {index = r3})]
|
||||
| None, None, Some r3, Some m1, Some m2, _ ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
LoadI (m2, tmpreg2);
|
||||
Load (tmpreg2, tmpreg2);
|
||||
BRegOp (brop, tmpreg1, tmpreg2, {index = r3})]
|
||||
| None, None, None, Some m1, Some m2, Some m3 ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
LoadI (m2, tmpreg2);
|
||||
Load (tmpreg2, tmpreg2);
|
||||
BRegOp (brop, tmpreg1, tmpreg2, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| _ -> [BRegOp (brop, {index = r1.index}, {index = r2.index}, {index = r3.index})]
|
||||
)
|
||||
| BImmOp (biop, r1, i, r3) -> (
|
||||
match ( VariableMap.find_opt r1.index remappedregisters,
|
||||
VariableMap.find_opt r3.index remappedregisters,
|
||||
VariableMap.find_opt r1.index memorymap,
|
||||
VariableMap.find_opt r3.index memorymap )
|
||||
with
|
||||
| Some r1, Some r3, _, _ ->
|
||||
[BImmOp (biop, {index = r1}, i, {index = r3})]
|
||||
| Some r1, None, _, Some m3 ->
|
||||
[BImmOp (biop, {index = r1}, i, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| None, Some r3, Some m1, _ ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
BImmOp (biop, tmpreg1, i, {index = r3})]
|
||||
| None, None, Some m1, Some m3 ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
BImmOp (biop, tmpreg1, i, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
|
||||
" registers have no binding.")
|
||||
)
|
||||
| URegOp (urop, r1, r3) ->(
|
||||
match ( VariableMap.find_opt r1.index remappedregisters,
|
||||
VariableMap.find_opt r3.index remappedregisters,
|
||||
VariableMap.find_opt r1.index memorymap,
|
||||
VariableMap.find_opt r3.index memorymap )
|
||||
with
|
||||
| Some r1, Some r3, _, _ ->
|
||||
[URegOp (urop, {index = r1}, {index = r3})]
|
||||
| Some r1, None, _, Some m3 ->
|
||||
[URegOp (urop, {index = r1}, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| None, Some r3, Some m1, _ ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
URegOp (urop, tmpreg1, {index = r3})]
|
||||
| None, None, Some m1, Some m3 ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
URegOp (urop, tmpreg1, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
|
||||
" registers have no binding.")
|
||||
)
|
||||
| Load (r1, r3) -> (
|
||||
match ( VariableMap.find_opt r1.index remappedregisters,
|
||||
VariableMap.find_opt r3.index remappedregisters,
|
||||
VariableMap.find_opt r1.index memorymap,
|
||||
VariableMap.find_opt r3.index memorymap )
|
||||
with
|
||||
| Some r1, Some r3, _, _ ->
|
||||
[Load ({index = r1}, {index = r3})]
|
||||
| Some r1, None, _, Some m3 ->
|
||||
[Load ({index = r1}, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| None, Some r3, Some m1, _ ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
Load (tmpreg1, {index = r3})]
|
||||
| None, None, Some m1, Some m3 ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
|
||||
" registers have no binding.")
|
||||
)
|
||||
| LoadI (i, r3) -> (
|
||||
(* we want to store an integer in memory immediately (strange, but
|
||||
unless better heuristic to choose the variables to replace we are
|
||||
stuck) *)
|
||||
match ( VariableMap.find_opt r3.index remappedregisters,
|
||||
VariableMap.find_opt r3.index memorymap )
|
||||
with
|
||||
| Some r3, _ ->
|
||||
[LoadI (i, {index = r3})]
|
||||
| None, Some m3 ->
|
||||
[LoadI (i, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
|
||||
" registers have no binding.")
|
||||
)
|
||||
| Store (r1, r3) -> (
|
||||
(* we want to maybe store an address in memory (very confusing, don't
|
||||
think can happen) *)
|
||||
match ( VariableMap.find_opt r1.index remappedregisters,
|
||||
VariableMap.find_opt r3.index remappedregisters,
|
||||
VariableMap.find_opt r1.index memorymap,
|
||||
VariableMap.find_opt r3.index memorymap )
|
||||
with
|
||||
| Some r1, Some r3, _, _ ->
|
||||
[Store ({index = r1}, {index = r3})]
|
||||
| Some r1, None, _, Some m3 ->
|
||||
[Store ({index = r1}, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| None, Some r3, Some m1, _ ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
Store (tmpreg1, {index = r3})]
|
||||
| None, None, Some m1, Some m3 ->
|
||||
[LoadI (m1, tmpreg1);
|
||||
Load (tmpreg1, tmpreg1);
|
||||
Store (tmpreg1, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
|
||||
" registers have no binding.")
|
||||
)
|
||||
in
|
||||
|
||||
List.map (fun x ->
|
||||
Printf.printf "Converting: %a\n" CfgRISC.RISCSimpleStatements.pp x;
|
||||
let tmp = aux x in
|
||||
Printf.printf "Into: %a\n\n" CfgRISC.RISCSimpleStatements.pplist tmp;
|
||||
tmp
|
||||
) code |> List.concat
|
||||
in
|
||||
|
||||
|
||||
let aux (cfg: RISCCfg.t) all_variables =
|
||||
(* we keep the first two variables free for immediate use *)
|
||||
let most_frequent, least_frequent =
|
||||
List.sort (fun (_a, fa) (_b, fb) -> Int.compare fb fa) all_variables
|
||||
|> Utility.take (n-2)
|
||||
in
|
||||
let most_frequent = fst (List.split most_frequent) in
|
||||
let least_frequent = fst (List.split least_frequent) in
|
||||
|
||||
(* we map the most frequent to new registers, so that the first two are
|
||||
always free *)
|
||||
let most_frequent_mapping = (* +3 because starts at 0, but we want to start
|
||||
at 1*)
|
||||
List.mapi (fun n v -> (v, (string_of_int (n+3): Variable.t))) most_frequent
|
||||
|> VariableMap.of_list
|
||||
in
|
||||
(* we map the least to memory *)
|
||||
let least_frequent_mapping =
|
||||
List.mapi (fun n v -> (v, (n: int))) least_frequent
|
||||
|> VariableMap.of_list
|
||||
in
|
||||
|
||||
Printf.printf "Most freq mapping:\n";
|
||||
List.iter (fun (a, b) -> Printf.printf "%s -> %s\n" a b) (VariableMap.to_list most_frequent_mapping);
|
||||
Printf.printf "Least freq mapping:\n";
|
||||
List.iter (fun (a, b) -> Printf.printf "%s -> mem %d\n" a b) (VariableMap.to_list least_frequent_mapping);
|
||||
|
||||
(* we need to replace both at the same time, because we might have mapped
|
||||
some registers to already used registers, so a double pass might not
|
||||
differentiate the two *)
|
||||
(* special care must be taken for the in and out registers *)
|
||||
let newcfg = {
|
||||
cfg with
|
||||
content = Cfg.NodeMap.map
|
||||
(fun x -> replaceregisters most_frequent_mapping least_frequent_mapping ["1"; "2"] x)
|
||||
cfg.content}
|
||||
in
|
||||
|
||||
match newcfg.inputOutputVar with
|
||||
| None -> newcfg (* if no input or output variables we ignore *)
|
||||
| Some (i, o) -> (
|
||||
match (VariableMap.find_opt i most_frequent_mapping,
|
||||
VariableMap.find_opt o most_frequent_mapping,
|
||||
VariableMap.find_opt i least_frequent_mapping,
|
||||
VariableMap.find_opt o least_frequent_mapping )
|
||||
with (*we check if in and out are simply remapped or are put in memory*)
|
||||
| Some i, Some o, _, _ ->
|
||||
{ newcfg with inputOutputVar = Some (i, o) }
|
||||
| Some i, None, _, Some mo -> ( (* since the output simbol is in memory
|
||||
we need to first retrive it and then
|
||||
put the result in a temporary
|
||||
register *)
|
||||
match newcfg.terminal with (* we check for the terminal node, if not
|
||||
present we are very confused and dont
|
||||
modify the out variable *)
|
||||
| None -> { newcfg with inputOutputVar = Some (i, o)}
|
||||
| Some n -> (
|
||||
let terminalcontent = (
|
||||
match Cfg.NodeMap.find_opt n newcfg.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
) @ [LoadI (mo, {index = "2"});
|
||||
Load ({index = "2"}, {index = "2"})]
|
||||
in
|
||||
let content = Cfg.NodeMap.add n terminalcontent newcfg.content in
|
||||
{ newcfg with
|
||||
inputOutputVar = Some (i, "2");
|
||||
content = content
|
||||
}
|
||||
)
|
||||
)
|
||||
| None, Some o, Some mi, _ -> ( (* the input simbol should be stored in
|
||||
memory *)
|
||||
match newcfg.initial with
|
||||
| None -> { newcfg with inputOutputVar = Some (i, o) }
|
||||
| Some n -> (
|
||||
let initialcontent =
|
||||
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
|
||||
Store ({index = "1"}, {index = "2"})] @ (
|
||||
match Cfg.NodeMap.find_opt n newcfg.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
)
|
||||
in
|
||||
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
|
||||
{ newcfg with
|
||||
inputOutputVar = Some ("1", o);
|
||||
content = content
|
||||
}
|
||||
)
|
||||
)
|
||||
| None, None, Some mi, Some mo -> ( (* both simbols should be in
|
||||
memory *)
|
||||
match newcfg.initial, newcfg.terminal with
|
||||
| None, None -> { newcfg with inputOutputVar = Some (i, o) }
|
||||
| None, Some n -> (
|
||||
let terminalcontent = (
|
||||
match Cfg.NodeMap.find_opt n newcfg.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
) @ [LoadI (mo, {index = "2"});
|
||||
Load ({index = "2"}, {index = "2"})]
|
||||
in
|
||||
let content = Cfg.NodeMap.add n terminalcontent newcfg.content in
|
||||
{ newcfg with
|
||||
inputOutputVar = Some (i, "2");
|
||||
content = content
|
||||
}
|
||||
)
|
||||
| Some n, None -> (
|
||||
let initialcontent =
|
||||
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
|
||||
Store ({index = "1"}, {index = "2"})] @ (
|
||||
match Cfg.NodeMap.find_opt n newcfg.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
)
|
||||
in
|
||||
let content = Cfg.NodeMap.add n initialcontent newcfg.content in
|
||||
{ newcfg with
|
||||
inputOutputVar = Some ("1", o);
|
||||
content = content
|
||||
}
|
||||
)
|
||||
| Some ni, Some no -> (
|
||||
let initialcontent =
|
||||
[(LoadI (mi, {index = "2"}) : RISCCfg.elt);
|
||||
Store ({index = "1"}, {index = "2"})] @ (
|
||||
match Cfg.NodeMap.find_opt ni newcfg.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
)
|
||||
in
|
||||
let terminalcontent = (
|
||||
match Cfg.NodeMap.find_opt no newcfg.content with
|
||||
| None -> []
|
||||
| Some x -> x
|
||||
) @ [LoadI (mo, {index = "2"});
|
||||
Load ({index = "2"}, {index = "2"})]
|
||||
in
|
||||
let content = Cfg.NodeMap.add ni initialcontent newcfg.content in
|
||||
let content = Cfg.NodeMap.add no terminalcontent content in
|
||||
{ newcfg with
|
||||
inputOutputVar = Some ("1", "2");
|
||||
content = content
|
||||
}
|
||||
)
|
||||
)
|
||||
| _ -> failwith ("ReduceRegisters: fail to partition a set, some" ^
|
||||
" registers have no binding.")
|
||||
)
|
||||
in
|
||||
|
||||
|
||||
( if List.length all_variables < n
|
||||
then cfg
|
||||
else aux cfg all_variables )
|
||||
3
lib/miniImp/reduceRegisters.mli
Normal file
3
lib/miniImp/reduceRegisters.mli
Normal file
@ -0,0 +1,3 @@
|
||||
module RISCCfg = CfgRISC.RISCCfg
|
||||
|
||||
val reduceregisters : int -> RISCCfg.t -> RISCCfg.t
|
||||
@ -52,6 +52,7 @@ let rec fromIntToString (alphabet: string) (x: int) : string =
|
||||
|> String.make 1)
|
||||
|
||||
|
||||
(* true if every element of la is in lb *)
|
||||
let inclusion la lb =
|
||||
let rec aux la =
|
||||
function
|
||||
@ -63,6 +64,11 @@ let inclusion la lb =
|
||||
in
|
||||
aux lb la
|
||||
|
||||
(* true if lb includes la and la includes lb *)
|
||||
let equality la lb =
|
||||
inclusion la lb && inclusion lb la
|
||||
|
||||
(* computes the result of la \setminus lb *)
|
||||
let subtraction la lb =
|
||||
let rec aux la =
|
||||
function
|
||||
@ -89,23 +95,40 @@ let unique l =
|
||||
let unique_union la lb =
|
||||
unique (la @ lb)
|
||||
|
||||
(* returns all elements both in la and in lb *)
|
||||
let unique_intersection la lb =
|
||||
let rec aux la lb acc =
|
||||
let rec aux la acc =
|
||||
match la with
|
||||
[] -> acc
|
||||
| a::la ->
|
||||
if List.mem a lb
|
||||
then aux la lb (a::acc)
|
||||
else aux la lb acc
|
||||
then aux la (a::acc)
|
||||
else aux la acc
|
||||
in
|
||||
aux la lb [] |> unique
|
||||
aux la [] |> unique
|
||||
|
||||
(* returns a list with at most n items and the rest in the second *)
|
||||
let rec take (n: int) (l: 'a list) : ('a list * 'a list) =
|
||||
match n with
|
||||
| 0 -> ([], l)
|
||||
| n ->
|
||||
match l with
|
||||
| [] -> ([], [])
|
||||
| i::ls ->
|
||||
let (t1, t2) = (take (n - 1) ls) in
|
||||
((i :: t1), (t2))
|
||||
|
||||
(* returns the list without the last element *)
|
||||
let drop_last_element_list =
|
||||
function
|
||||
| [] -> []
|
||||
| l -> l |> List.rev |> List.tl |> List.rev
|
||||
|
||||
let drop_first_element_list =
|
||||
function
|
||||
| [] -> []
|
||||
| _::l -> l
|
||||
|
||||
(* Complicated way to drop the last element and add a new option element to the
|
||||
beginning *)
|
||||
let prev l a =
|
||||
@ -152,6 +175,13 @@ let add_to_last_list (la: 'a list list) (a: 'a) : 'a list list =
|
||||
in
|
||||
aux la a
|
||||
|
||||
let rec combine_twice la lb =
|
||||
match (la, lb) with
|
||||
| [], [] -> []
|
||||
| [a], [b] -> [a, b]
|
||||
| a::la, b::lb -> (a, b) :: (combine_twice la lb)
|
||||
| _ -> []
|
||||
|
||||
let rec combine_thrice la lb lc =
|
||||
match (la, lb, lc) with
|
||||
| [], [], [] -> []
|
||||
|
||||
@ -13,13 +13,17 @@ val int_not : int -> int
|
||||
val fromIntToString : string -> int -> string
|
||||
|
||||
val inclusion : 'a list -> 'a list -> bool
|
||||
val equality : 'a list -> 'a list -> bool
|
||||
val subtraction : 'a list -> 'a list -> 'a list
|
||||
|
||||
val unique : 'a list -> 'a list
|
||||
val unique_union : 'a list -> 'a list -> 'a list
|
||||
val unique_intersection : 'a list -> 'a list -> 'a list
|
||||
|
||||
val drop_last_element_list : 'a list -> 'a list
|
||||
val take : int -> 'a list -> ('a list * 'a list)
|
||||
|
||||
val drop_last_element_list : 'a list -> 'a list
|
||||
val drop_first_element_list : 'a list -> 'a list
|
||||
val prev : 'a list -> 'a option -> 'a option list
|
||||
|
||||
val pad : 'a list -> 'a option -> int -> 'a option list
|
||||
@ -29,4 +33,5 @@ val combine : 'a list -> 'b option list -> ('a * 'b) option list
|
||||
val last_list : 'a list -> 'a
|
||||
val add_to_last_list : 'a list list -> 'a -> 'a list list
|
||||
|
||||
val combine_twice : 'a list -> 'b list -> ('a * 'b) list
|
||||
val combine_thrice : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list
|
||||
|
||||
Reference in New Issue
Block a user