Fixes wrong order for conversion

This commit is contained in:
elvis
2024-12-02 00:45:24 +01:00
parent 52cd7e7e13
commit 15356aa5a9
5 changed files with 163 additions and 116 deletions

View File

@ -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

View File

@ -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 =

View File

@ -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