Minor modifications, adding comments
This commit is contained in:
@ -25,7 +25,6 @@ module SimpleStatements = struct
|
||||
| SimpleDivision of simpleArithmetic * simpleArithmetic
|
||||
| SimpleModulo of simpleArithmetic * simpleArithmetic
|
||||
| SimplePower of simpleArithmetic * simpleArithmetic
|
||||
| SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
|
||||
| SimpleRand of simpleArithmetic
|
||||
|
||||
let pp (ppf: out_channel) (c: t) : unit =
|
||||
@ -55,7 +54,6 @@ module SimpleStatements = struct
|
||||
| SimpleDivision (a1, a2) -> Printf.fprintf ppf "{%a / %a}" helper_a a1 helper_a a2
|
||||
| SimpleModulo (a1, a2) -> Printf.fprintf ppf "{%a %% %a}" helper_a a1 helper_a a2
|
||||
| SimplePower (a1, a2) -> Printf.fprintf ppf "{%a ^ %a}" helper_a a1 helper_a a2
|
||||
| SimplePowerMod (a1, a2, a3) -> Printf.fprintf ppf "{powmod %a %a %a}" helper_a a1 helper_a a2 helper_a a3
|
||||
| SimpleRand (a) -> Printf.fprintf ppf "{rand %a}" helper_a a
|
||||
in
|
||||
helper_c ppf c
|
||||
@ -69,18 +67,19 @@ module SSCfg = Cfg.Make(SimpleStatements)
|
||||
let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
|
||||
let open SimpleStatements in
|
||||
match prg with
|
||||
| Skip ->
|
||||
| Skip -> (* we preserve the skips *)
|
||||
prevcfg |> SSCfg.addToLastNode SimpleSkip
|
||||
|
||||
| Assignment (x, a) ->
|
||||
| Assignment (x, a) -> (* we simply add the assignment to the terminal node *)
|
||||
prevcfg |> SSCfg.addToLastNode (SimpleAssignment (x, convert_a a))
|
||||
|
||||
| Sequence (c1, c2) ->
|
||||
| Sequence (c1, c2) -> (* we first convert the first sequence, then the second
|
||||
using the previous as prevcfg *)
|
||||
let cfg1 = convert_c prevcfg c1 in
|
||||
let cfg2 = convert_c cfg1 c2 in
|
||||
cfg2
|
||||
|
||||
| If (b, c1, c2) ->
|
||||
| If (b, c1, c2) -> (* constructs two branches with a two new nodes *)
|
||||
let convertedb = convert_b b in
|
||||
let cfg1 = convert_c SSCfg.empty c1 in
|
||||
let cfg2 = convert_c SSCfg.empty c2 in
|
||||
@ -93,7 +92,7 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
|
||||
NodeMap.add_to_list entrynode (SimpleGuard convertedb) |>
|
||||
NodeMap.add_to_list exitnode (SimpleSkip) }
|
||||
|
||||
| While (b, c) ->
|
||||
| While (b, c) -> (* constructs a loop, needs three new nodes *)
|
||||
let convertedb = convert_b b in
|
||||
let cfg = convert_c SSCfg.empty c in
|
||||
let cfginitial = Option.get cfg.initial in
|
||||
@ -124,7 +123,8 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t =
|
||||
NodeMap.add_to_list exitnode (SimpleSkip)
|
||||
} |> SSCfg.concat prevcfg
|
||||
|
||||
| For (assignment, guard, increment, body) ->
|
||||
| For (assignment, guard, increment, body) -> (* constructs a loop, needs
|
||||
two new nodes *)
|
||||
let cfgassignment = convert_c SSCfg.empty assignment in
|
||||
let convertedguard = convert_b guard in
|
||||
let cfgincrement = convert_c SSCfg.empty increment in
|
||||
|
||||
@ -24,7 +24,6 @@ module SimpleStatements : sig
|
||||
| SimpleDivision of simpleArithmetic * simpleArithmetic
|
||||
| SimpleModulo of simpleArithmetic * simpleArithmetic
|
||||
| SimplePower of simpleArithmetic * simpleArithmetic
|
||||
| SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
|
||||
| SimpleRand of simpleArithmetic
|
||||
|
||||
val pp : out_channel -> t -> unit
|
||||
|
||||
@ -706,9 +706,6 @@ and c_ss_sa
|
||||
(convertedcode @ [BRegOp (Pow, partialresreg1, partialresreg2, register)], m)
|
||||
)
|
||||
)
|
||||
| SimplePowerMod (_a1, _a2, _a3) -> (
|
||||
failwith "not implemented"
|
||||
)
|
||||
| SimpleRand (a) -> (
|
||||
let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
|
||||
let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
|
||||
|
||||
@ -32,7 +32,7 @@
|
||||
%left DIVISION
|
||||
%left MODULO
|
||||
%left TIMES
|
||||
%left POWER
|
||||
%right POWER
|
||||
%left DO
|
||||
|
||||
%%
|
||||
|
||||
@ -19,6 +19,8 @@ module RISCArchitecture = struct
|
||||
end
|
||||
|
||||
let convert (prg: RISC.RISCAssembly.t) : RISC.RISCAssembly.risci list CodeMap.t =
|
||||
(* takes as input a sequence of RISC commands and computes a map to the right
|
||||
labels for easier execution *)
|
||||
let rec helper
|
||||
(prg: RISC.RISCAssembly.risci list)
|
||||
(current: RISC.RISCAssembly.risci list)
|
||||
@ -98,7 +100,8 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
None -> prg (* should never happen *)
|
||||
| Some i ->
|
||||
if i + 1 < (List.length lo) then
|
||||
helper prg (CodeMap.find (List.nth lo (i+1)) prg.code) (List.nth lo (i+1))
|
||||
helper
|
||||
prg (CodeMap.find (List.nth lo (i+1)) prg.code) (List.nth lo (i+1))
|
||||
else
|
||||
prg
|
||||
)
|
||||
@ -109,32 +112,45 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
(RegisterMap.find {index = r2.index} prg.registers)
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
helper { prg with
|
||||
registers = RegisterMap.add {index = r3.index} n prg.registers }
|
||||
tl current_label
|
||||
)
|
||||
| BImmOp (biop, r1, i, r3) :: tl -> (
|
||||
let n = (match_operator_i biop)
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
i
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
helper { prg with
|
||||
registers = RegisterMap.add {index = r3.index} n prg.registers }
|
||||
tl current_label
|
||||
)
|
||||
| URegOp (urop, r1, r3) :: tl -> (
|
||||
match urop with
|
||||
| Copy -> (
|
||||
let n = RegisterMap.find {index = r1.index} prg.registers in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
helper { prg with
|
||||
registers =
|
||||
RegisterMap.add {index = r3.index} n prg.registers }
|
||||
tl current_label
|
||||
)
|
||||
| Not -> (
|
||||
let n = Utility.int_not
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
helper { prg with
|
||||
registers =
|
||||
RegisterMap.add {index = r3.index} n prg.registers }
|
||||
tl current_label
|
||||
)
|
||||
| Rand -> (
|
||||
let n = Random.int
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
helper { prg with
|
||||
registers =
|
||||
RegisterMap.add {index = r3.index} n prg.registers }
|
||||
tl current_label
|
||||
)
|
||||
)
|
||||
| Load (r1, r3) :: tl -> (
|
||||
@ -143,12 +159,16 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
prg.memory
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
helper { prg with
|
||||
registers = RegisterMap.add {index = r3.index} n prg.registers }
|
||||
tl current_label
|
||||
)
|
||||
| LoadI (i, r3) :: tl -> (
|
||||
let n = i
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
helper { prg with
|
||||
registers = RegisterMap.add {index = r3.index} n prg.registers }
|
||||
tl current_label
|
||||
)
|
||||
| Store (r1, r3) :: tl -> (
|
||||
let n = RegisterMap.find {index = r1.index} prg.registers in
|
||||
@ -166,12 +186,17 @@ let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
)
|
||||
| Label _ :: tl -> helper prg tl current_label
|
||||
in
|
||||
RegisterMap.find
|
||||
prg.outputreg
|
||||
(helper prg (CodeMap.find "main" prg.code) "main").registers
|
||||
match
|
||||
RegisterMap.find_opt
|
||||
prg.outputreg
|
||||
(helper prg (CodeMap.find "main" prg.code) "main").registers
|
||||
with
|
||||
Some x -> x
|
||||
| None -> failwith "Output register not found"
|
||||
|
||||
|
||||
let reduce (prg: RISC.RISCAssembly.t) : int =
|
||||
(* takes assembly and execute it *)
|
||||
reduce_instructions
|
||||
{code = convert prg;
|
||||
registers = (
|
||||
|
||||
@ -191,6 +191,7 @@ let update (t: DVCfg.t) (node: Cfg.Node.t) : DVCfg.internalnode =
|
||||
|
||||
|
||||
let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
|
||||
(* creates the DVCfg structure and finds the fixed point *)
|
||||
let all_variables = List.fold_left
|
||||
(fun acc (_, code) ->
|
||||
Utility.unique_union acc (variables_all code))
|
||||
@ -208,6 +209,7 @@ let compute_defined_variables (cfg: RISCCfg.t) : DVCfg.t =
|
||||
|
||||
|
||||
let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
|
||||
(* returns all undefined variables previously computed *)
|
||||
let helper (node: Cfg.Node.t) (dvcfg: DVCfg.t) : Variable.t list option =
|
||||
let code = match Cfg.NodeMap.find_opt node dvcfg.t.content with
|
||||
None -> []
|
||||
@ -257,4 +259,5 @@ let check_undefined_variables (dvcfg: DVCfg.t) : Variable.t list option =
|
||||
|
||||
|
||||
let compute_cfg (dvcfg: DVCfg.t) : RISCCfg.t =
|
||||
(* no change to the cfg so returned as is *)
|
||||
DVCfg.to_cfg dvcfg
|
||||
|
||||
@ -238,14 +238,14 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
|
||||
(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)
|
||||
(fun node (assign, t) -> aux assign t node)
|
||||
t.t.nodes
|
||||
(assignments, t)
|
||||
in
|
||||
|
||||
@ -18,7 +18,8 @@ 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 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) : int VariableMap.t =
|
||||
match instr with
|
||||
@ -40,7 +41,9 @@ let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
|
||||
|
||||
helper VariableMap.empty instr |> VariableMap.to_list
|
||||
|
||||
let variables_all_frequency (instructions : RISCCfg.elt list) : (Variable.t * int) list =
|
||||
(* computes syntactic frequency of all variables in the code *)
|
||||
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
|
||||
@ -50,16 +53,20 @@ let variables_all_frequency (instructions : RISCCfg.elt list) : (Variable.t * in
|
||||
|
||||
|
||||
let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
(if n < 4 then (failwith "ReduceRegisters: number of registers too small") else ());
|
||||
(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_assoc (fun _n x y -> x + y) acc (variables_all_frequency code))
|
||||
Utility.unique_union_assoc
|
||||
(fun _n x y -> x + y) acc (variables_all_frequency code))
|
||||
[]
|
||||
(Cfg.NodeMap.to_list cfg.content)
|
||||
in
|
||||
|
||||
(* add one to in and out variables *)
|
||||
let all_variables =
|
||||
match cfg.inputOutputVar with
|
||||
| None -> all_variables
|
||||
@ -80,6 +87,8 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
)
|
||||
in
|
||||
|
||||
(* replace each operation with a list of operations that have the new
|
||||
registers or load from memory *)
|
||||
let replaceregisters
|
||||
(remappedregisters: Variable.t VariableMap.t)
|
||||
(memorymap: int VariableMap.t)
|
||||
@ -143,7 +152,10 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
BRegOp (brop, tmpreg1, tmpreg2, tmpreg2);
|
||||
LoadI (m3, tmpreg1);
|
||||
Store (tmpreg2, tmpreg1)]
|
||||
| _ -> [BRegOp (brop, {index = r1.index}, {index = r2.index}, {index = r3.index})]
|
||||
| _ -> [BRegOp (brop,
|
||||
{index = r1.index},
|
||||
{index = r2.index},
|
||||
{index = r3.index})]
|
||||
)
|
||||
| BImmOp (biop, r1, i, r3) -> (
|
||||
match ( VariableMap.find_opt r1.index remappedregisters,
|
||||
@ -237,8 +249,8 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
" registers have no binding.")
|
||||
)
|
||||
| Store (r1, r3) -> (
|
||||
(* we want to maybe store an address in memory (very confusing, don't
|
||||
think can happen) *)
|
||||
(* we want to maybe store an address in memory (very confusing,
|
||||
but maybe possible) *)
|
||||
match ( VariableMap.find_opt r1.index remappedregisters,
|
||||
VariableMap.find_opt r3.index remappedregisters,
|
||||
VariableMap.find_opt r1.index memorymap,
|
||||
@ -269,6 +281,8 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
in
|
||||
|
||||
|
||||
(* partition the variables into two sets, most frequent and least frequent
|
||||
then apply the transformation *)
|
||||
let aux (cfg: RISCCfg.t) (all_variables: (string * int) list) =
|
||||
(* we keep the first two variables free for immediate use *)
|
||||
let most_frequent, least_frequent =
|
||||
@ -298,8 +312,13 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
let newcfg = {
|
||||
cfg with
|
||||
content = Cfg.NodeMap.map
|
||||
(fun x -> replaceregisters most_frequent_mapping least_frequent_mapping ["1"; "2"] x)
|
||||
cfg.content}
|
||||
( fun x ->
|
||||
replaceregisters
|
||||
most_frequent_mapping
|
||||
least_frequent_mapping
|
||||
["1"; "2"]
|
||||
x
|
||||
) cfg.content}
|
||||
in
|
||||
|
||||
match newcfg.inputOutputVar with
|
||||
@ -417,7 +436,6 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|
||||
)
|
||||
in
|
||||
|
||||
|
||||
( if List.length all_variables <= n
|
||||
then cfg
|
||||
else aux cfg all_variables )
|
||||
|
||||
@ -1,10 +1,8 @@
|
||||
let rewrite_instructions (prg: Types.p_exp) : Types.p_exp =
|
||||
(* function takes a program and replaces all occurrences of powermod with
|
||||
simpler instructions *)
|
||||
let i, o, prg = (
|
||||
match prg with
|
||||
| Main (i, o, exp) -> i, o, exp
|
||||
) in
|
||||
|
||||
let Main (i, o, prg) = prg in
|
||||
|
||||
let rec contains_rewrite (prg: Types.c_exp) : Types.a_exp option =
|
||||
(* if the ast contains powermod anywhere returns the powermod, otherwise
|
||||
|
||||
Reference in New Issue
Block a user