open Analysis module RISCSimpleStatements = struct type register = { index: string } type t = | Nop | BRegOp of brop * register * register * register | BImmOp of biop * register * int * register | URegOp of urop * register * register | Load of register * register | LoadI of int * register | Store of register * register and brop = | Add | Sub | Mult | Div | Mod | Pow | And | Or | Eq | Less | LessEq | More | MoreEq and biop = | AddI | SubI | MultI | DivI | ModI | PowI | AndI | OrI | EqI | LessI | LessEqI | MoreI | MoreEqI and urop = | Not | Copy | Rand let pp (ppf: out_channel) (v: t) : unit = let rec pp_t (ppf: out_channel) (v: t) : unit = match v with Nop -> Printf.fprintf ppf "Nop" | BRegOp (b, r1, r2, r3) -> Printf.fprintf ppf "%a r%s r%s => r%s" pp_brop b r1.index r2.index r3.index | BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "%a r%s %d => r%s" pp_biop b r1.index i r3.index | URegOp (u, r1, r2) -> Printf.fprintf ppf "%a r%s => r%s" pp_urop u r1.index r2.index | Load (r1, r2) -> Printf.fprintf ppf "Load r%s => r%s" r1.index r2.index | LoadI (i, r2) -> Printf.fprintf ppf "LoadI %d => r%s" i r2.index | Store (r1, r2) -> Printf.fprintf ppf "Store r%s => r%s" r1.index r2.index and pp_brop (ppf: out_channel) (v: brop) : unit = match v with Add -> Printf.fprintf ppf "Add" | Sub -> Printf.fprintf ppf "Sub" | Mult -> Printf.fprintf ppf "Mult" | Div -> Printf.fprintf ppf "Div" | Mod -> Printf.fprintf ppf "Mod" | Pow -> Printf.fprintf ppf "Pow" | And -> Printf.fprintf ppf "And" | Or -> Printf.fprintf ppf "Or" | Eq -> Printf.fprintf ppf "Eq" | Less -> Printf.fprintf ppf "Less" | LessEq -> Printf.fprintf ppf "LessEq" | More -> Printf.fprintf ppf "More" | MoreEq -> Printf.fprintf ppf "MoreEq" and pp_biop (ppf: out_channel) (v: biop) : unit = match v with AddI -> Printf.fprintf ppf "AddI" | SubI -> Printf.fprintf ppf "SubI" | MultI -> Printf.fprintf ppf "MultI" | DivI -> Printf.fprintf ppf "DivI" | ModI -> Printf.fprintf ppf "ModI" | PowI -> Printf.fprintf ppf "PowI" | AndI -> Printf.fprintf ppf "AndI" | OrI -> Printf.fprintf ppf "OrI" | EqI -> Printf.fprintf ppf "EqI" | LessI -> Printf.fprintf ppf "LessI" | LessEqI -> Printf.fprintf ppf "LessEqI" | MoreI -> Printf.fprintf ppf "MoreI" | MoreEqI -> Printf.fprintf ppf "MoreEqI" and pp_urop (ppf: out_channel) (v: urop) : unit = match v with Not -> Printf.fprintf ppf "Nop" | Copy -> Printf.fprintf ppf "Copy" | Rand -> Printf.fprintf ppf "Rand" in pp_t ppf v let pplist (ppf: out_channel) (l: t list) : unit = List.iter (fun x -> pp ppf x; Printf.printf "; ") l end module RISCCfg = Cfg.Make(RISCSimpleStatements) let globalcounter = ref 0 module RegisterMap = struct type m = { assignments: RISCSimpleStatements.register Types.VariableMap.t } let set_register (x: Types.variable) (v: RISCSimpleStatements.register) (m: m) : m = {assignments = Types.VariableMap.add x v m.assignments} 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 = string_of_int !globalcounter}, {assignments = Types.VariableMap.add x ({index = (string_of_int !globalcounter)}: RISCSimpleStatements.register) m.assignments})) | Some i -> (i, m) let get_fresh_register (m: m) : RISCSimpleStatements.register * m * Types.variable = globalcounter := !globalcounter + 1; let freshvariable = string_of_int !globalcounter in ({index = string_of_int !globalcounter}, {assignments = Types.VariableMap.add freshvariable ({index = string_of_int !globalcounter}: RISCSimpleStatements.register) m.assignments}, freshvariable) let empty : m = {assignments = Types.VariableMap.empty} 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 -> (convertedcode @ [Nop], m) | SimpleAssignment (v, sa) -> ( let r1, m = RegisterMap.get_or_set_register v m in c_ss_sa sa m convertedcode r1 ) | SimpleGuard (b) -> ( 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) (convertedcode: RISCSimpleStatements.t list) (register: RISCSimpleStatements.register) : RISCSimpleStatements.t list * RegisterMap.m = match ss with SimpleBoolean (b) -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in if b then (convertedcode @ [LoadI (1, partialresreg)], m) else (convertedcode @ [LoadI (0, partialresreg)], m) ) | SimpleBAnd (b1, b2) -> ( match (b1, b2) with | (SimpleBoolean (true), b) | (b, SimpleBoolean (true)) -> ( c_ss_sb b m convertedcode register ) | (SimpleBoolean (false), _) | (_, SimpleBoolean (false)) -> ( (convertedcode @ [LoadI (0, 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_sb b1 m convertedcode partialresreg1 in let convertedcode, m = c_ss_sb b2 m convertedcode partialresreg2 in (convertedcode @ [BRegOp (And, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBOr (b1, b2) -> ( match (b1, b2) with | (SimpleBoolean (false), b) | (b, SimpleBoolean (false)) -> ( c_ss_sb b m convertedcode register ) | (SimpleBoolean (true), _) | (_, SimpleBoolean (true)) -> ( (LoadI (1, register) :: convertedcode, 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 (convertedcode @ [BRegOp (Or, partialresreg1, partialresreg2, register)], m) ) ) | SimpleBNot (b) -> ( match (b) with | SimpleBoolean (b) -> ( if b then (LoadI (0, register) :: convertedcode, m) else (LoadI (1, register) :: convertedcode, m) ) | _ -> ( let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in let convertedcode, m = c_ss_sb b m convertedcode partialresreg in (convertedcode @ [URegOp (Not, partialresreg, register)], m) ) ) | SimpleBCmp (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 (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 (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 (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 (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 (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 (convertedcode @ [BImmOp (MoreI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (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 (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 (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 (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 (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 (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 (convertedcode @ [BImmOp (MoreEqI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (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 (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 (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 (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 (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 (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 (convertedcode @ [BImmOp (LessI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (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 (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 (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 (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 (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 (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 (convertedcode @ [BImmOp (LessEqI, xreg, i, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (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 (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 (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 (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 (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 (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) (convertedcode: RISCSimpleStatements.t list) (register: RISCSimpleStatements.register) : RISCSimpleStatements.t list * RegisterMap.m = match ss with SimpleVariable (x) -> ( let r1, m = RegisterMap.get_or_set_register x m in (convertedcode @ [URegOp (Copy, r1, register)], m) ) | SimpleInteger (i) -> ( (convertedcode @ [LoadI (i, register)], 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 (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 (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 (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 (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 (convertedcode @ [BRegOp (Add, partialresreg1, partialresreg2, register)], m) ) ) | SimpleMinus (a1, a2) -> ( match (a1, a2) with | (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 (convertedcode @ [LoadI (i, partialresreg); BRegOp (Sub, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (convertedcode @ [LoadI (i, partialresregi); 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 (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 (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 (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 (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 (convertedcode @ [BRegOp (Sub, partialresreg1, partialresreg2, register)], m) ) ) | SimpleTimes (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 (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 (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 (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 (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 (convertedcode @ [BRegOp (Mult, partialresreg1, partialresreg2, register)], m) ) ) | SimpleDivision (a1, a2) -> ( match (a1, a2) with | (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 (convertedcode @ [LoadI (i, partialresreg); BRegOp (Div, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (convertedcode @ [LoadI (i, partialresregi); 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 (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 (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 (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 (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 (convertedcode @ [BRegOp (Div, partialresreg1, partialresreg2, register)], m) ) ) | SimpleModulo (a1, a2) -> ( match (a1, a2) with | (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 (convertedcode @ [LoadI (i, partialresreg); BRegOp (Mod, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (convertedcode @ [LoadI (i, partialresregi); 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 (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 (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 (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 (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 (convertedcode @ [BRegOp (Mod, partialresreg1, partialresreg2, register)], m) ) ) | SimplePower (a1, a2) -> ( match (a1, a2) with | (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 (convertedcode @ [LoadI (i, partialresreg); BRegOp (Pow, partialresreg, xreg, register)], m) ) | (SimpleVariable (x), SimpleInteger (i)) -> ( let xreg, m = RegisterMap.get_or_set_register x m in (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 (convertedcode @ [LoadI (i, partialresregi); 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 (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 (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 (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 (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 (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 (convertedcode @ [URegOp (Rand, partialresreg, register)], m) ) let convert_ss (m: RegisterMap.m) (value: CfgImp.SimpleStatements.t list) (node: Cfg.Node.t) (risccode: RISCSimpleStatements.t list Cfg.NodeMap.t) : RISCSimpleStatements.t list Cfg.NodeMap.t * RegisterMap.m = (* 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 -> 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 = (* *) (* 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 = match prg with { empty: bool; nodes: Cfg.NodeSet.t; edges: (Cfg.Node.t * (Cfg.Node.t option)) Cfg.NodeMap.t; reverseEdges: (Cfg.Node.t list) Cfg.NodeMap.t; inputVal: int option; inputOutputVar: (string * string) option; initial: Cfg.Node.t option; terminal: Cfg.Node.t option; content: CfgImp.SimpleStatements.t list Cfg.NodeMap.t } -> let initial_bindings = match inputOutputVar with | Some (i, o) -> RegisterMap.empty |> RegisterMap.set_register i {index = "in"} |> RegisterMap.set_register o {index = "out"} | None -> RegisterMap.empty in { empty = empty; nodes = nodes; edges = edges; reverseEdges = reverseEdges; inputVal = inputVal; inputOutputVar = Some ("in", "out"); initial = initial; terminal = terminal; content = helper content initial_bindings; }