From cf0bc41a236c2ea6714437836619cd9d4aee4d84 Mon Sep 17 00:00:00 2001 From: elvis Date: Wed, 15 Jan 2025 00:10:44 +0100 Subject: [PATCH] Minor modifications, adding comments --- bin/miniFunInterpreter.ml | 3 ++- bin/miniImpInterpreterReg.ml | 35 +++++++++++++++++++----- lib/analysis/Dataflow.ml | 12 ++++++--- lib/analysis/Dataflow.mli | 4 ++- lib/miniFun/Lexer.mll | 1 + lib/miniFun/Parser.mly | 3 +-- lib/miniImp/CfgImp.ml | 16 +++++------ lib/miniImp/CfgImp.mli | 1 - lib/miniImp/CfgRISC.ml | 3 --- lib/miniImp/Parser.mly | 2 +- lib/miniImp/RISCSemantics.ml | 47 +++++++++++++++++++++++++-------- lib/miniImp/definedVariables.ml | 3 +++ lib/miniImp/liveVariables.ml | 4 +-- lib/miniImp/reduceRegisters.ml | 38 +++++++++++++++++++------- lib/miniImp/replacePowerMod.ml | 6 ++--- 15 files changed, 124 insertions(+), 54 deletions(-) diff --git a/bin/miniFunInterpreter.ml b/bin/miniFunInterpreter.ml index 43bea4b..ea20218 100644 --- a/bin/miniFunInterpreter.ml +++ b/bin/miniFunInterpreter.ml @@ -58,7 +58,8 @@ let () = | Lexer.LexingError msg -> Printf.fprintf stderr "%a: %s\n" print_position lexbuf msg; exit (-1) - | Parser.Error -> Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf; + | Parser.Error -> + Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf; exit (-1) in let _ = diff --git a/bin/miniImpInterpreterReg.ml b/bin/miniImpInterpreterReg.ml index 7de8e42..9bbb5c3 100644 --- a/bin/miniImpInterpreterReg.ml +++ b/bin/miniImpInterpreterReg.ml @@ -5,7 +5,7 @@ open Lexing (* Command Arguments *) let () = - Clap.description "Interpreter for MiniImp language."; + Clap.description "Interpreter for MiniImp language to RISC code."; let files = Clap.section ~description: "Files to consider." "FILES" in let values = Clap.section ~description: "Input values." "VALUES" in @@ -36,6 +36,22 @@ let () = false in + let checkundefined = Clap.flag + ~description: "Optional flag for disabling the check for undefined variables." + ~section: values + ~unset_long: "undefined" + ~unset_short: 'u' + true + in + + let optimizereg = Clap.flag + ~description: "Optional flag for disabling optimizing registers with liveness analysis." + ~section: values + ~unset_long: "liveness" + ~unset_short: 'l' + true + in + let inputval = Clap.default_int ~description: "Optional input value to feed to the program. \ If not specified it is read from stdin." @@ -85,7 +101,7 @@ let () = CfgRISC.convert in - let () = ( + if checkundefined then ( match DefinedVariables.compute_defined_variables return_value |> DefinedVariables.check_undefined_variables with @@ -94,13 +110,20 @@ let () = Printf.printf "Error: undefined variables: %a\n" DefinedVariables.Variable.pplist l; exit (-1) - ) in + ) else (); + + let return_value = + if optimizereg then + return_value |> + LiveVariables.compute_live_variables |> + LiveVariables.optimize_cfg |> + LiveVariables.compute_cfg + else + return_value + in let return_value = return_value |> - LiveVariables.compute_live_variables |> - LiveVariables.optimize_cfg |> - LiveVariables.compute_cfg |> ReduceRegisters.reduceregisters registers |> RISC.convert in diff --git a/lib/analysis/Dataflow.ml b/lib/analysis/Dataflow.ml index ef14743..da583f8 100644 --- a/lib/analysis/Dataflow.ml +++ b/lib/analysis/Dataflow.ml @@ -41,7 +41,9 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct 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) + -> acc && + (Utility.equality ain bin) && + (Utility.equality aout bout) ) true a.internalbetween b.internalbetween) with | true, true, true -> true @@ -54,7 +56,7 @@ 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) = + let compareinternal a b = Cfg.NodeMap.fold (fun node bi acc -> match Cfg.NodeMap.find_opt node a with @@ -141,7 +143,9 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct let fixed_point ?(init : (elt list -> internalnode) = - (fun _ -> {internalin = []; internalout = []; internalbetween = []})) + (fun _ -> {internalin = []; + internalout = []; + internalbetween = []})) ?(update : (t -> Cfg.Node.t -> internalnode) = (fun t n -> Cfg.NodeMap.find n t.internalvar)) (t: t) @@ -150,7 +154,7 @@ module Make (M: Cfg.PrintableType) (I: Cfg.PrintableType) = struct 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 + observed with compareinternal function *) let rec helper t = let newt = diff --git a/lib/analysis/Dataflow.mli b/lib/analysis/Dataflow.mli index f45667f..76e9cfa 100644 --- a/lib/analysis/Dataflow.mli +++ b/lib/analysis/Dataflow.mli @@ -18,7 +18,9 @@ module type C = sig val from_cfg : cfgt -> t val to_cfg : t -> cfgt - val fixed_point : ?init:(elt list -> internalnode) -> ?update:(t -> Cfg.Node.t -> internalnode) -> t -> t + val fixed_point : + ?init:(elt list -> internalnode) -> + ?update:(t -> Cfg.Node.t -> internalnode) -> t -> t val pp : out_channel -> t -> unit end diff --git a/lib/miniFun/Lexer.mll b/lib/miniFun/Lexer.mll index f9ebd40..030df9d 100644 --- a/lib/miniFun/Lexer.mll +++ b/lib/miniFun/Lexer.mll @@ -81,6 +81,7 @@ rule read = parse (lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum) (lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum) ))} + and comments level = parse | "*)" {if level = 0 then read lexbuf diff --git a/lib/miniFun/Parser.mly b/lib/miniFun/Parser.mly index bfdec51..022d618 100644 --- a/lib/miniFun/Parser.mly +++ b/lib/miniFun/Parser.mly @@ -24,7 +24,6 @@ %start prg (* associativity in order of precedence *) -/*%right rightlowest */ %left lowest %right TYPEFUNCTION %left COMMA @@ -35,7 +34,7 @@ %left CMP CMPLESS CMPLESSEQ CMPGREATER CMPGREATEREQ %left PLUS MINUS %left TIMES DIVISION MODULO -%left POWER +%right POWER %right BNOT RAND %left FIRST SECOND %left LAMBDA diff --git a/lib/miniImp/CfgImp.ml b/lib/miniImp/CfgImp.ml index 54f58c6..0428ea3 100644 --- a/lib/miniImp/CfgImp.ml +++ b/lib/miniImp/CfgImp.ml @@ -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 diff --git a/lib/miniImp/CfgImp.mli b/lib/miniImp/CfgImp.mli index dfcbfc6..5e933a1 100644 --- a/lib/miniImp/CfgImp.mli +++ b/lib/miniImp/CfgImp.mli @@ -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 diff --git a/lib/miniImp/CfgRISC.ml b/lib/miniImp/CfgRISC.ml index f85fda2..2f86c3d 100644 --- a/lib/miniImp/CfgRISC.ml +++ b/lib/miniImp/CfgRISC.ml @@ -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 diff --git a/lib/miniImp/Parser.mly b/lib/miniImp/Parser.mly index e52eb52..50adf99 100644 --- a/lib/miniImp/Parser.mly +++ b/lib/miniImp/Parser.mly @@ -32,7 +32,7 @@ %left DIVISION %left MODULO %left TIMES -%left POWER +%right POWER %left DO %% diff --git a/lib/miniImp/RISCSemantics.ml b/lib/miniImp/RISCSemantics.ml index db35686..cec0683 100644 --- a/lib/miniImp/RISCSemantics.ml +++ b/lib/miniImp/RISCSemantics.ml @@ -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 = ( diff --git a/lib/miniImp/definedVariables.ml b/lib/miniImp/definedVariables.ml index 7694bb0..4ace70e 100644 --- a/lib/miniImp/definedVariables.ml +++ b/lib/miniImp/definedVariables.ml @@ -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 diff --git a/lib/miniImp/liveVariables.ml b/lib/miniImp/liveVariables.ml index a721d85..1987fee 100644 --- a/lib/miniImp/liveVariables.ml +++ b/lib/miniImp/liveVariables.ml @@ -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 diff --git a/lib/miniImp/reduceRegisters.ml b/lib/miniImp/reduceRegisters.ml index 81d0edc..5ebdf41 100644 --- a/lib/miniImp/reduceRegisters.ml +++ b/lib/miniImp/reduceRegisters.ml @@ -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 ) diff --git a/lib/miniImp/replacePowerMod.ml b/lib/miniImp/replacePowerMod.ml index e2016ba..030fe3e 100644 --- a/lib/miniImp/replacePowerMod.ml +++ b/lib/miniImp/replacePowerMod.ml @@ -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