Minor modifications, adding comments

This commit is contained in:
elvis
2025-01-15 00:10:44 +01:00
parent 11adaa5103
commit cf0bc41a23
15 changed files with 124 additions and 54 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -32,7 +32,7 @@
%left DIVISION
%left MODULO
%left TIMES
%left POWER
%right POWER
%left DO
%%

View File

@ -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 = (

View File

@ -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

View File

@ -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

View File

@ -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 )

View File

@ -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