From 15356aa5a9b9bd6d059a3b8555a1f6a6f4548a40 Mon Sep 17 00:00:00 2001 From: elvis Date: Mon, 2 Dec 2024 00:45:24 +0100 Subject: [PATCH] Fixes wrong order for conversion --- lib/cfg/Cfg.ml | 14 ++- lib/cfg/Cfg.mli | 7 +- lib/miniImp/CfgImp.ml | 17 ++- lib/miniImp/CfgRISC.ml | 235 ++++++++++++++++++++++------------------- lib/miniImp/RISC.ml | 6 +- 5 files changed, 163 insertions(+), 116 deletions(-) diff --git a/lib/cfg/Cfg.ml b/lib/cfg/Cfg.ml index 70e26a9..f9b6fb8 100644 --- a/lib/cfg/Cfg.ml +++ b/lib/cfg/Cfg.ml @@ -18,7 +18,15 @@ module Node = struct end ;; -module NodeMap = Map.Make(Node) +module NodeMap = struct + include Map.Make(Node) + + let add_to_list_last x data m = + let add = function None -> Some [data] + | Some l -> Some (l @ [data]) in + update x add m +end + module NodeSet = Set.Make(Node) module type C = sig @@ -141,7 +149,7 @@ module Make(M: PrintableType) = struct | false -> let prevcfgterminal = Option.get cfg.terminal in { cfg with - content = (NodeMap.add_to_list + content = (NodeMap.add_to_list_last prevcfgterminal newcontent cfg.content) } @@ -192,7 +200,7 @@ module Make(M: PrintableType) = struct Printf.fprintf ppf "Code:\n"; List.iter (fun ((n, stms) : Node.t * elt list) : unit -> - Printf.fprintf ppf "\tid %d --> %a\n%!" n.id M.pplist (List.rev stms) + Printf.fprintf ppf "\tid %d --> %a\n%!" n.id M.pplist stms ) (NodeMap.to_list c.content); Printf.fprintf ppf "\n"; end diff --git a/lib/cfg/Cfg.mli b/lib/cfg/Cfg.mli index 1c23d2d..d331259 100644 --- a/lib/cfg/Cfg.mli +++ b/lib/cfg/Cfg.mli @@ -12,7 +12,12 @@ module Node : sig val create : unit -> t end -module NodeMap : Map.S with type key = Node.t +module NodeMap : sig + include Map.S with type key = Node.t + + val add_to_list_last : key -> 'a -> 'a list t -> 'a list t +end + module NodeSet : Set.S with type elt = Node.t module type C = sig diff --git a/lib/miniImp/CfgImp.ml b/lib/miniImp/CfgImp.ml index 6655d30..59584d3 100644 --- a/lib/miniImp/CfgImp.ml +++ b/lib/miniImp/CfgImp.ml @@ -68,12 +68,17 @@ 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 -> prevcfg |> SSCfg.addToLastNode SimpleSkip - | Assignment (x, a) -> prevcfg |> SSCfg.addToLastNode (SimpleAssignment (x, convert_a a)) + | Skip -> + prevcfg |> SSCfg.addToLastNode SimpleSkip + + | Assignment (x, a) -> + prevcfg |> SSCfg.addToLastNode (SimpleAssignment (x, convert_a a)) + | Sequence (c1, c2) -> let cfg1 = convert_c prevcfg c1 in let cfg2 = convert_c cfg1 c2 in cfg2 + | If (b, c1, c2) -> let convertedb = convert_b b in let cfg1 = convert_c SSCfg.empty c1 in @@ -86,6 +91,7 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = content = mergedcfg.content |> NodeMap.add_to_list entrynode (SimpleGuard convertedb) |> NodeMap.add_to_list exitnode (SimpleSkip) } + | While (b, c) -> let convertedb = convert_b b in let cfg = convert_c SSCfg.empty c in @@ -112,9 +118,11 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = inputOutputVar = prevcfg.inputOutputVar; initial = Some entrynode; terminal = Some exitnode; - content = NodeMap.add_to_list guardnode (SimpleGuard (convertedb)) cfg.content |> + content = cfg.content |> + NodeMap.add_to_list guardnode (SimpleGuard (convertedb)) |> NodeMap.add_to_list exitnode (SimpleSkip) } |> SSCfg.concat prevcfg + | For (assignment, guard, increment, body) -> let cfgassignment = convert_c SSCfg.empty assignment in let convertedguard = convert_b guard in @@ -144,7 +152,8 @@ let rec convert_c (prevcfg: SSCfg.t) (prg: Types.c_exp) : SSCfg.t = inputOutputVar = prevcfg.inputOutputVar; initial = Some guardnode; terminal = Some exitnode; - content = NodeMap.add_to_list guardnode (SimpleGuard (convertedguard)) bodyincrement.content |> + content = bodyincrement.content |> + NodeMap.add_to_list guardnode (SimpleGuard (convertedguard)) |> NodeMap.add_to_list exitnode (SimpleSkip) } |> SSCfg.concat prevassignment diff --git a/lib/miniImp/CfgRISC.ml b/lib/miniImp/CfgRISC.ml index 0a71b79..69e0e2b 100644 --- a/lib/miniImp/CfgRISC.ml +++ b/lib/miniImp/CfgRISC.ml @@ -103,42 +103,37 @@ module RegisterMap = struct type m = { assignments: int Types.VariableMap.t } - let _get_opt_register (x: Types.variable) (m: m) : RISCSimpleStatements.register option = - Option.bind - (Types.VariableMap.find_opt x m.assignments) - (fun (x: int) : RISCSimpleStatements.register option -> Some {index = x}) - let get_or_set_register (x: Types.variable) (m: m) : RISCSimpleStatements.register * m = + let get_or_set_register (x: Types.variable) (m: m) + : RISCSimpleStatements.register * m = match Types.VariableMap.find_opt x m.assignments with None -> ( globalcounter := !globalcounter + 1; - ({index = !globalcounter}, {assignments = Types.VariableMap.add x !globalcounter m.assignments}) ) + ({index = !globalcounter}, + {assignments = Types.VariableMap.add x !globalcounter m.assignments})) | Some i -> ({index = i}, m) - let get_fresh_register (m: m) : RISCSimpleStatements.register * m * Types.variable = + let get_fresh_register (m: m) + : RISCSimpleStatements.register * m * Types.variable = globalcounter := !globalcounter + 1; let freshvariable = string_of_int !globalcounter in ({index = !globalcounter}, - {assignments = Types.VariableMap.add freshvariable !globalcounter m.assignments}, + {assignments = + Types.VariableMap.add freshvariable !globalcounter m.assignments}, freshvariable) let empty : m = {assignments = Types.VariableMap.empty} - - (* let pp (ppx) (m: m) : unit = *) - (* Printf.fprintf ppx "RegisterMap contents: "; *) - (* List.iter (fun (n, v) -> Printf.fprintf ppx "%s -> %d, " n v) (Types.VariableMap.to_list m.assignments); *) - (* Printf.fprintf ppx "\n"; *) end - +(* converts a simple statement into RISC simple statements *) let rec c_ss_t (ss: CfgImp.SimpleStatements.t) (m: RegisterMap.m) (convertedcode: RISCSimpleStatements.t list) : RISCSimpleStatements.t list * RegisterMap.m = match ss with - SimpleSkip -> (Nop :: convertedcode, m) + SimpleSkip -> (convertedcode @ [Nop], m) | SimpleAssignment (v, sa) -> ( let r1, m = RegisterMap.get_or_set_register v m in c_ss_sa sa m convertedcode r1 @@ -147,6 +142,10 @@ let rec c_ss_t let returnreg, m, _returnregvar = RegisterMap.get_fresh_register m in c_ss_sb b m convertedcode returnreg ) + +(* converts a boolean simple statement into RISC simple statements, requires + the register where the result sould be put into, does a lookahead to optimize + with operations where an integer is one side of the operation *) and c_ss_sb (ss: CfgImp.SimpleStatements.simpleBoolean) (m: RegisterMap.m) @@ -157,9 +156,9 @@ and c_ss_sb SimpleBoolean (b) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in if b then - (LoadI (partialresreg, 1) :: convertedcode, m) + (convertedcode @ [LoadI (partialresreg, 1)], m) else - (LoadI (partialresreg, 0) :: convertedcode, m) + (convertedcode @ [LoadI (partialresreg, 0)], m) ) | SimpleBAnd (b1, b2) -> ( match (b1, b2) with @@ -169,14 +168,14 @@ and c_ss_sb ) | (SimpleBoolean (false), _) | (_, SimpleBoolean (false)) -> ( - (LoadI (register, 0) :: convertedcode, m) + (convertedcode @ [LoadI (register, 0)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sb b1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sb b2 m convertedcode partialresreg2 in - (BRegOp (And, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (And, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBOr (b1, b2) -> ( @@ -194,7 +193,7 @@ and c_ss_sb let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sb b1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sb b2 m convertedcode partialresreg2 in - (BRegOp (Or, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Or, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBNot (b) -> ( @@ -208,7 +207,7 @@ and c_ss_sb | _ -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sb b m convertedcode partialresreg in - (URegOp (Not, partialresreg, register) :: convertedcode, m) + (convertedcode @ [URegOp (Not, partialresreg, register)], m) ) ) | SimpleBCmp (a1, a2) -> ( @@ -216,215 +215,218 @@ and c_ss_sb | (SimpleInteger (i), SimpleVariable (x)) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (EqI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (EqI, xreg, i, register)], m) ) | (SimpleInteger (i), a) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (EqI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (EqI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Eq, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Eq, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Eq, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Eq, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Eq, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Eq, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBCmpLess (a1, a2) -> ( match (a1, a2) with | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (MoreI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (LessI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (MoreI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (LessI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Less, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Less, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Less, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Less, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Less, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Less, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Less, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Less, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBCmpLessEq (a1, a2) -> ( match (a1, a2) with | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (MoreEqI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (LessEqI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (MoreEqI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (LessEqI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (LessEq, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (LessEq, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (LessEq, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (LessEq, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (LessEq, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (LessEq, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (LessEq, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (LessEq, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBCmpGreater (a1, a2) -> ( match (a1, a2) with | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (LessI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (MoreI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (LessI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessI, partialresreg, i, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (MoreI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (More, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (More, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (More, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (More, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (More, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (More, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (More, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (More, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBCmpGreaterEq (a1, a2) -> ( match (a1, a2) with | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (LessEqI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (MoreEqI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (LessEqI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (LessEqI, partialresreg, i, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (MoreEqI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MoreEqI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (MoreEq, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (MoreEq, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (MoreEq, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (MoreEq, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (MoreEq, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (MoreEq, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (MoreEq, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (MoreEq, partialresreg1, partialresreg2, register)], m) ) ) +(* converts a arithmetic simple statement into RISC simple statements, requires + the register where the result sould be put into, does a lookahead to optimize + with operations where an integer is one side of the operation *) and c_ss_sa (ss: CfgImp.SimpleStatements.simpleArithmetic) (m: RegisterMap.m) @@ -434,40 +436,42 @@ and c_ss_sa match ss with SimpleVariable (x) -> ( let r1, m = RegisterMap.get_or_set_register x m in - (Load (r1, register) :: convertedcode, m) + (convertedcode @ [Load (r1, register)], m) + ) + | SimpleInteger (i) -> ( + (convertedcode @ [LoadI (register, i)], m) ) - | SimpleInteger (i) -> (LoadI (register, i) :: convertedcode, m) | SimplePlus (a1, a2) -> ( match (a1, a2) with | (SimpleInteger (i), SimpleVariable (x)) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (AddI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (AddI, xreg, i, register)], m) ) | (SimpleInteger (i), a) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (AddI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (AddI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Add, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Add, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Add, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Add, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Add, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Add, partialresreg1, partialresreg2, register)], m) ) ) | SimpleMinus (a1, a2) -> ( @@ -475,46 +479,46 @@ and c_ss_sa | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in - (BRegOp (Sub, partialresreg, xreg, register) :: LoadI (partialresreg, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresreg, i); BRegOp (Sub, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (SubI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (SubI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Sub, partialresregi, partialresreg, register) :: LoadI (partialresregi, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresregi, i); BRegOp (Sub, partialresregi, partialresreg, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (SubI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (SubI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Sub, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Sub, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Sub, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Sub, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Sub, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Sub, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Sub, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Sub, partialresreg1, partialresreg2, register)], m) ) ) | SimpleTimes (a1, a2) -> ( @@ -522,32 +526,32 @@ and c_ss_sa | (SimpleInteger (i), SimpleVariable (x)) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (MultI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MultI, xreg, i, register)], m) ) | (SimpleInteger (i), a) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (MultI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (MultI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Mult, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Mult, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Mult, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Mult, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Mult, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Mult, partialresreg1, partialresreg2, register)], m) ) ) | SimpleDivision (a1, a2) -> ( @@ -555,46 +559,46 @@ and c_ss_sa | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in - (BRegOp (Div, partialresreg, xreg, register) :: LoadI (partialresreg, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresreg, i); BRegOp (Div, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (DivI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (DivI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Div, partialresregi, partialresreg, register) :: LoadI (partialresregi, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresregi, i); BRegOp (Div, partialresregi, partialresreg, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (DivI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (DivI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Div, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Div, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Div, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Div, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Div, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Div, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Div, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Div, partialresreg1, partialresreg2, register)], m) ) ) | SimpleModulo (a1, a2) -> ( @@ -602,46 +606,46 @@ and c_ss_sa | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in - (BRegOp (Mod, partialresreg, xreg, register) :: LoadI (partialresreg, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresreg, i); BRegOp (Mod, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (ModI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (ModI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Mod, partialresregi, partialresreg, register) :: LoadI (partialresregi, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresregi, i); BRegOp (Mod, partialresregi, partialresreg, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (ModI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (ModI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Mod, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Mod, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Mod, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Mod, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Mod, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Mod, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Mod, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Mod, partialresreg1, partialresreg2, register)], m) ) ) | SimplePower (a1, a2) -> ( @@ -649,53 +653,53 @@ and c_ss_sa | (SimpleInteger (i), SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in - (BRegOp (Pow, partialresreg, xreg, register) :: LoadI (partialresreg, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresreg, i); BRegOp (Pow, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in - (BImmOp (PowI, xreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (PowI, xreg, i, register)], m) ) | (SimpleInteger (i), a) -> ( let partialresregi, m, _partialresvari = RegisterMap.get_fresh_register m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Pow, partialresregi, partialresreg, register) :: LoadI (partialresregi, i) :: convertedcode, m) + (convertedcode @ [LoadI (partialresregi, i); BRegOp (Pow, partialresregi, partialresreg, register)], m) ) | (a, SimpleInteger (i)) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BImmOp (PowI, partialresreg, i, register) :: convertedcode, m) + (convertedcode @ [BImmOp (PowI, partialresreg, i, register)], m) ) | (SimpleVariable (x), SimpleVariable (y)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let yreg, m = RegisterMap.get_or_set_register y m in - (BRegOp (Pow, xreg, yreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Pow, xreg, yreg, register)], m) ) | (SimpleVariable (x), a) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Pow, xreg, partialresreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Pow, xreg, partialresreg, register)], m) ) | (a, SimpleVariable (x)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (BRegOp (Pow, partialresreg, xreg, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Pow, partialresreg, xreg, register)], m) ) | (_, _) -> ( let partialresreg1, m, _partialresvar1 = RegisterMap.get_fresh_register m in let partialresreg2, m, _partialresvar2 = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sa a2 m convertedcode partialresreg2 in - (BRegOp (Pow, partialresreg1, partialresreg2, register) :: convertedcode, m) + (convertedcode @ [BRegOp (Pow, partialresreg1, partialresreg2, register)], m) ) ) | SimplePowerMod (_a1, _a2, _a3) -> failwith "Not implemented Powermod" | SimpleRand (a) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sa a m convertedcode partialresreg in - (URegOp (Rand, partialresreg, register) :: convertedcode, m) + (convertedcode @ [URegOp (Rand, partialresreg, register)], m) ) let convert_ss @@ -704,12 +708,29 @@ let convert_ss (node: Cfg.Node.t) (risccode: RISCSimpleStatements.t list Cfg.NodeMap.t) : RISCSimpleStatements.t list Cfg.NodeMap.t * RegisterMap.m = - let instructions, m = List.fold_right (fun code (convertedcode, m) -> - c_ss_t code m convertedcode) value ([], m) in + (* we iterate over the list of simple statements and convert each operation to + the equivalent three address operations, we need to propagate the + association between variables and registers so we choose a fold instead of + a mapreduce *) + let instructions, m = List.fold_left + (fun (convertedcode, m) code -> ( + Printf.printf "considering: %a\n" CfgImp.SimpleStatements.pp code; + c_ss_t code m convertedcode)) + ([], m) value + in (Cfg.NodeMap.add node instructions risccode, m) -let helper (c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t) (m: RegisterMap.m) : RISCSimpleStatements.t list Cfg.NodeMap.t = - let risccode, _ = Cfg.NodeMap.fold (fun node value (risccode, m) -> convert_ss m value node risccode) c (Cfg.NodeMap.empty, m) in +let helper + (c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t) + (m: RegisterMap.m) + : RISCSimpleStatements.t list Cfg.NodeMap.t = + (* *) + (* we use NodeMap.fold since order is not important, we assume that every + has an associated register and we ignore use before assignment errors *) + let risccode, _ = Cfg.NodeMap.fold + (fun node value (risccode, m) -> convert_ss m value node risccode) + c (Cfg.NodeMap.empty, m) + in risccode let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t = diff --git a/lib/miniImp/RISC.ml b/lib/miniImp/RISC.ml index f59f4b7..cf69c2d 100644 --- a/lib/miniImp/RISC.ml +++ b/lib/miniImp/RISC.ml @@ -197,7 +197,11 @@ let rec helper (prg: CfgRISC.RISCCfg.t) (currentnode: Cfg.Node.t) (alreadyVisite ([], alreadyVisited) else ( let nextnodes = (Cfg.NodeMap.find_opt currentnode prg.edges) in - let currentcode = (Cfg.NodeMap.find currentnode prg.content |> convert_cfgrisc_risci) in + let currentcode = + (match (Cfg.NodeMap.find_opt currentnode prg.content) with + | None -> [] + | Some x -> convert_cfgrisc_risci x) + in match nextnodes with | Some (nextnode1, None) -> let res, vis = (helper prg nextnode1) (currentnode :: alreadyVisited) in