976 lines
38 KiB
OCaml
976 lines
38 KiB
OCaml
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)
|
|
)
|
|
)
|
|
| 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 =
|
|
let ({ 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
|
|
}: CfgImp.SSCfg.t) = prg
|
|
in
|
|
let initial_bindings =
|
|
match inputOutputVar with
|
|
| Some (i, o) -> (
|
|
if i = o then
|
|
RegisterMap.empty |>
|
|
RegisterMap.set_register i {index = "in"}
|
|
else
|
|
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 = (
|
|
match inputOutputVar with
|
|
| Some (i, o) -> (
|
|
if i = o then
|
|
Some ("in", "in")
|
|
else
|
|
Some ("in", "out")
|
|
)
|
|
| None -> Some ("in", "out")
|
|
);
|
|
initial = initial;
|
|
terminal = terminal;
|
|
content = helper content initial_bindings;
|
|
}
|