aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/eurm.ml38
1 files changed, 21 insertions, 17 deletions
diff --git a/src/eurm.ml b/src/eurm.ml
index 68605e7..7d857d2 100644
--- a/src/eurm.ml
+++ b/src/eurm.ml
@@ -7,23 +7,26 @@ open Common
7 7
8let end_label = "end" 8let end_label = "end"
9 9
10let compile_preprocess = 10let compile_preprocess cmd_list =
11 let rec id_from_name tbl name = match Hashtbl.find_opt tbl name with 11 let rec id_from_name tbl name = string_of_int (List.assoc name tbl)
12 | Some(id) -> id 12 and build_label_table cmd_list =
13 | None -> let new_id = string_of_int (Hashtbl.length tbl) in Hashtbl.add tbl name new_id; new_id 13 List.filter (fun cmd -> match cmd with | Label(_) -> true | _ -> false) cmd_list
14 and aux tbl = function 14 |> List.mapi (fun id cmd -> match cmd with | Label(name) -> (name, id) | _ -> failwith "Unexpected state")
15 and rewrite_label tbl = function
16 | Label(name) -> Label(id_from_name tbl name)
17 | EqPredicate(i, j, name) -> EqPredicate(i, j, id_from_name tbl name)
18 | GEqPredicate(i, j, name) -> GEqPredicate(i, j, id_from_name tbl name)
19 | GTPredicate(i, j, name) -> GTPredicate(i, j, id_from_name tbl name)
20 | LEqPredicate(i, j, name) -> LEqPredicate(i, j, id_from_name tbl name)
21 | LTPredicate(i, j, name) -> LTPredicate(i, j, id_from_name tbl name)
22 | ZeroPredicate(i, name) -> ZeroPredicate(i, id_from_name tbl name)
23 | Goto(name) -> Goto(id_from_name tbl name)
24 | any -> any
25 and rewrite_labels tbl = function
15 | [] -> [ Label(end_label) ] 26 | [] -> [ Label(end_label) ]
16 | Comment(_) :: tail -> aux tbl tail 27 | any :: tail -> rewrite_label tbl any :: rewrite_labels tbl tail
17 | Label(name) :: tail -> Label(id_from_name tbl name) :: aux tbl tail 28 in let cmds = List.filter (fun cmd -> match cmd with | Comment(_) -> false | _ -> true) cmd_list
18 | EqPredicate(i, j, name) :: tail -> EqPredicate(i, j, id_from_name tbl name) :: aux tbl tail 29 in rewrite_labels (build_label_table cmds) cmds
19 | GEqPredicate(i, j, name) :: tail -> GEqPredicate(i, j, id_from_name tbl name) :: aux tbl tail
20 | GTPredicate(i, j, name) :: tail -> GTPredicate(i, j, id_from_name tbl name) :: aux tbl tail
21 | LEqPredicate(i, j, name) :: tail -> LEqPredicate(i, j, id_from_name tbl name) :: aux tbl tail
22 | LTPredicate(i, j, name) :: tail -> LTPredicate(i, j, id_from_name tbl name) :: aux tbl tail
23 | ZeroPredicate(i, name) :: tail -> ZeroPredicate(i, id_from_name tbl name) :: aux tbl tail
24 | Goto(name) :: tail -> Goto(id_from_name tbl name) :: aux tbl tail
25 | any :: tail -> any :: aux tbl tail
26 in aux (Hashtbl.create 100)
27 30
28let build_initial_state eurmcmds = 31let build_initial_state eurmcmds =
29 let max_reg_of_instr = function 32 let max_reg_of_instr = function
@@ -138,11 +141,12 @@ let compile_stage4 eurmcmds state =
138 |> List.filter (fun (cmd, _) -> match cmd with | Label(_) -> true | _ -> false) 141 |> List.filter (fun (cmd, _) -> match cmd with | Label(_) -> true | _ -> false)
139 |> List.map (fun (cmd, lineno) -> match cmd with | Label(lbl) -> (lbl, lineno) | _ -> failwith "Unexpected state") 142 |> List.map (fun (cmd, lineno) -> match cmd with | Label(lbl) -> (lbl, lineno) | _ -> failwith "Unexpected state")
140 |> put_labels state 143 |> put_labels state
144 and lineno_from_label state lbl = List.assoc lbl state.label_table
141 in let transform state = function 145 in let transform state = function
142 | Inc(r) -> [ URMSucc(r) ], state 146 | Inc(r) -> [ URMSucc(r) ], state
143 | Zero(r) -> [ URMZero(r) ], state 147 | Zero(r) -> [ URMZero(r) ], state
144 | Copy(r1, r2) -> [ URMCopy(r1, r2) ], state 148 | Copy(r1, r2) -> [ URMCopy(r1, r2) ], state
145 | EqPredicate(r1, r2, lbl) -> [ URMJump(r1, r2, List.assoc lbl state.label_table) ], state 149 | EqPredicate(r1, r2, lbl) -> [ URMJump(r1, r2, lineno_from_label state lbl) ], state
146 | Label(_) -> 150 | Label(_) ->
147 let dummy_reg = make_reg state 1 151 let dummy_reg = make_reg state 1
148 in [ URMZero(dummy_reg) ], add_reg_label state 1 0 152 in [ URMZero(dummy_reg) ], add_reg_label state 1 0