From df0471407ecf95b831f66feadd693730a7e16af7 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 30 Apr 2018 15:04:07 +0200
Subject: Implement state and eurm compilation stage 1

---
 src/common.mli |  5 ++++-
 src/eurm.ml    | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 58 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/common.mli b/src/common.mli
index 1e32d57..16ffc87 100644
--- a/src/common.mli
+++ b/src/common.mli
@@ -41,6 +41,9 @@ type urm = {
   regs : reg list
 }
 
-type state = { todo : int }
+type state = {
+  max_reg : int;
+  label_count : int
+}
 
 exception Syntax_error
diff --git a/src/eurm.ml b/src/eurm.ml
index 6985f06..99a5d5e 100644
--- a/src/eurm.ml
+++ b/src/eurm.ml
@@ -10,7 +10,7 @@ let compile_preprocess =
   and id_from_name name = match Hashtbl.find_opt label_table name with
     | Some(id) -> id
     | None -> let new_id = string_of_int (Hashtbl.length label_table)
-              in Hashtbl.add label_table name new_id; new_id
+      in Hashtbl.add label_table name new_id; new_id
   and aux = function
     | [] -> []
     | Comment(_) :: tail -> aux tail
@@ -25,15 +25,65 @@ let compile_preprocess =
     | any :: tail -> any :: aux tail
   in aux
 
-let compile_stage1 eurmcmds state = eurmcmds, state
+let build_initial_state eurmcmds =
+  let max_reg_of_instr = function
+    | Dec(r) | Inc(r) | Zero(r) | ZeroPredicate(r, _) -> r
+    | Add(r1, r2) | Copy(r1, r2) | Mult(r1, r2) | Sub(r1, r2)
+    | EqPredicate(r1, r2, _) | GEqPredicate(r1, r2, _) | GTPredicate(r1, r2, _)
+    | LEqPredicate(r1, r2, _) | LTPredicate(r1, r2, _) -> max r1 r2
+    | _ -> 0
+  in {
+    max_reg = List.fold_left (fun acc instr -> max acc (max_reg_of_instr instr)) 0 eurmcmds;
+    label_count = List.fold_left (fun acc instr -> acc + (match instr with | Label(_) -> 1 | _ -> 0)) 0 eurmcmds
+  }
+
+let rec compile_stage1 eurmcmds state =
+  let transform = function
+    | Dec(r) ->
+      let new_reg = state.max_reg + 1
+      in [ Zero(new_reg); Inc(new_reg); Sub(r, new_reg) ],
+         { max_reg = new_reg; label_count = state.label_count }
+
+    | GEqPredicate(r1, r2, l) ->
+      let new_reg = state.max_reg + 1
+      in [ Copy(new_reg, r1); Inc(new_reg); GTPredicate(new_reg, r2, l) ],
+         { max_reg = new_reg; label_count = state.label_count }
+
+    | LEqPredicate(r1, r2, l) ->
+      let new_reg = state.max_reg + 1
+      in [ Copy(new_reg, r2); Inc(new_reg); GTPredicate(new_reg, r1, l) ],
+         { max_reg = new_reg; label_count = state.label_count }
+
+    | Mult(r1, r2) ->
+      let ctr_reg = state.max_reg + 1 and res_reg = state.max_reg + 2
+      and start_label = string_of_int (state.label_count + 1) and end_label = string_of_int (state.label_count + 2)
+      in [ Zero(ctr_reg); Zero(res_reg); Label(start_label); EqPredicate(ctr_reg, r2, end_label);
+           Add(res_reg, r1); Inc(ctr_reg); Goto(start_label); Label(end_label) ],
+         { max_reg = state.max_reg + 2; label_count = state.label_count + 2}
+
+    | ZeroPredicate(r, l) ->
+      let new_reg = state.max_reg + 1
+      in [ Zero(new_reg); EqPredicate(r, new_reg, l) ],
+         { max_reg = new_reg; label_count = state.label_count }
+
+    | LTPredicate(r1, r2, l) -> [ GTPredicate(r2, r1, l) ], state
+    | any -> [ any ], state
+
+  in match eurmcmds with
+  | [] -> [], state
+  | cmd :: tail ->
+    let substitution, new_state = transform cmd
+    in let prgm_tail, end_state = compile_stage1 tail new_state
+    in substitution @ prgm_tail, end_state
+
+
 let compile_stage2 eurmcmds state = eurmcmds, state
 let compile_stage3 eurmcmds state = eurmcmds, state
 let compile_stage4 eurmcmds state = [URMZero(0)], state
 
 let urm_from_eurm eurmcmds =
   let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state
-  and initial_state = 0
-  in (compile_preprocess eurmcmds, initial_state)
+  in (compile_preprocess eurmcmds, build_initial_state eurmcmds)
      |> chain compile_stage1
      |> chain compile_stage2
      |> chain compile_stage3
-- 
cgit v1.2.3