Semantics for RISC code

lib/miniImp/CfgRISC.ml

@@ -1,6 +1,6 @@
 module RISCSimpleStatements = struct
   type register = {
-    index: int
+    index: string
   }
 
   type t =
@@ -48,12 +48,12 @@ module RISCSimpleStatements = struct
     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
+      | 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 (r2, i) -> 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"
@@ -101,25 +101,34 @@ module RISCCfg = Cfg.Make(RISCSimpleStatements)
 let globalcounter = ref 0
 module RegisterMap = struct
   type m = {
-    assignments: int Types.VariableMap.t
+    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 = !globalcounter},
-         {assignments = Types.VariableMap.add x !globalcounter m.assignments}))
-    | Some i -> ({index = i}, m)
+      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 = !globalcounter},
+    ({index = string_of_int !globalcounter},
      {assignments =
-        Types.VariableMap.add freshvariable !globalcounter m.assignments},
+        Types.VariableMap.add freshvariable
+          ({index = string_of_int !globalcounter}: RISCSimpleStatements.register)
+          m.assignments},
      freshvariable)
 
   let empty : m =
@@ -436,7 +445,7 @@ and c_ss_sa
   match ss with
     SimpleVariable (x) -> (
       let r1, m = RegisterMap.get_or_set_register x m in
-      (convertedcode @ [Load (r1, register)], m)
+      (convertedcode @ [URegOp (Copy, r1, register)], m)
     )
   | SimpleInteger (i) -> (
       (convertedcode @ [LoadI (register, i)], m)
@@ -695,7 +704,9 @@ and c_ss_sa
           (convertedcode @ [BRegOp (Pow, partialresreg1, partialresreg2, register)], m)
         )
     )
-  | SimplePowerMod (_a1, _a2, _a3) -> failwith "Not implemented Powermod"
+  | SimplePowerMod (_a1, _a2, _a3) -> (
+      failwith "not implemented"
+    )
   | SimpleRand (a) -> (
       let partialresreg, m, _partialresvar = RegisterMap.get_fresh_register m in
       let convertedcode, m = c_ss_sa a m convertedcode partialresreg in
@@ -713,9 +724,7 @@ let convert_ss
      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))
+      (fun (convertedcode, m) code -> c_ss_t code m convertedcode)
       ([], m) value
   in
   (Cfg.NodeMap.add node instructions risccode, m)
@@ -744,13 +753,23 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
     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 = helper content RegisterMap.empty;
-       }
+  } ->
+  let initial_bindings =
+    match inputOutputVar with
+    | Some (i, o) ->
+      RegisterMap.empty |>
+      RegisterMap.set_register i {index = "in"} |>
+      RegisterMap.set_register o {index = "out"}
+    | None ->
+      RegisterMap.empty
+  in
+  { empty = empty;
+    nodes = nodes;
+    edges = edges;
+    reverseEdges = reverseEdges;
+    inputVal = inputVal;
+    inputOutputVar = inputOutputVar;
+    initial = initial;
+    terminal = terminal;
+    content = helper content initial_bindings;
+  }