460 lines
19 KiB
OCaml
460 lines
19 KiB
OCaml
|
module RISCSimpleStatements = struct
|
||
|
|
type register = {
|
||
|
|
index: int
|
||
|
|
}
|
||
|
|
|
||
|
|
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 register * int
|
||
|
|
| 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%d r%d => r%d" pp_brop b r1.index r2.index r3.index
|
||
|
|
| BImmOp (b, r1, i, r3) -> Printf.fprintf ppf "%a r%d %d => r%d" pp_biop b r1.index i r3.index
|
||
|
|
| URegOp (u, r1, r2) -> Printf.fprintf ppf "%a r%d => r%d" pp_urop u r1.index r2.index
|
||
|
|
| Load (r1, r2) -> Printf.fprintf ppf "load r%d => r%d" r1.index r2.index
|
||
|
|
| LoadI (r2, i) -> Printf.fprintf ppf "loadi %d => r%d" i r2.index
|
||
|
|
| Store (r1, r2) -> Printf.fprintf ppf "store r%d => r%d" 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: 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 =
|
||
|
|
match Types.VariableMap.find_opt x m.assignments with
|
||
|
|
None ->
|
||
|
|
( globalcounter := !globalcounter + 1;
|
||
|
|
({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 =
|
||
|
|
globalcounter := !globalcounter + 1;
|
||
|
|
let freshvariable = string_of_int !globalcounter in
|
||
|
|
({index = !globalcounter},
|
||
|
|
{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
|
||
|
|
|
||
|
|
|
||
|
|
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)
|
||
|
|
| 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
|
||
|
|
)
|
||
|
|
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
|
||
|
|
(LoadI (partialresreg, 1) :: convertedcode, m)
|
||
|
|
else
|
||
|
|
(LoadI (partialresreg, 0) :: convertedcode, 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)) -> (
|
||
|
|
(LoadI (register, 0) :: 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
|
||
|
|
(BRegOp (And, partialresreg1, partialresreg2, register) :: convertedcode, 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 (register, 1) :: 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
|
||
|
|
(BRegOp (Or, partialresreg1, partialresreg2, register) :: convertedcode, m)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleBNot (b) -> (
|
||
|
|
match (b) with
|
||
|
|
| SimpleBoolean (b) ->(
|
||
|
|
if b then
|
||
|
|
(LoadI (register, 0) :: convertedcode, m)
|
||
|
|
else
|
||
|
|
(LoadI (register, 1) :: convertedcode, m)
|
||
|
|
)
|
||
|
|
| _ -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleBCmp (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleBCmpLess (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleBCmpLessEq (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleBCmpGreater (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleBCmpGreaterEq (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
|
||
|
|
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
|
||
|
|
(Load (r1, register) :: convertedcode, m)
|
||
|
|
)
|
||
|
|
| SimpleInteger (i) -> (LoadI (register, i) :: convertedcode, m)
|
||
|
|
| SimplePlus (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleMinus (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleTimes (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleDivision (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimpleModulo (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| SimplePower (a1, a2) -> (
|
||
|
|
match (a1, a2) with
|
||
|
|
| (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)
|
||
|
|
)
|
||
|
|
| (_, _) -> (
|
||
|
|
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)
|
||
|
|
)
|
||
|
|
)
|
||
|
|
| 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)
|
||
|
|
)
|
||
|
|
|
||
|
|
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 =
|
||
|
|
let instructions, m = List.fold_right (fun code (convertedcode, m) ->
|
||
|
|
c_ss_t code m convertedcode) value ([], m) 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
|
||
|
|
risccode
|
||
|
|
|
||
|
|
let convert_content (c: CfgImp.SimpleStatements.t list Cfg.NodeMap.t) : RISCSimpleStatements.t list Cfg.NodeMap.t =
|
||
|
|
helper c RegisterMap.empty
|
||
|
|
|
||
|
|
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
|
||
|
|
} -> { empty = empty;
|
||
|
|
nodes = nodes;
|
||
|
|
edges = edges;
|
||
|
|
reverseEdges = reverseEdges;
|
||
|
|
inputVal = inputVal;
|
||
|
|
inputOutputVar = inputOutputVar;
|
||
|
|
initial = initial;
|
||
|
|
terminal = terminal;
|
||
|
|
content = convert_content content;
|
||
|
|
}
|