diff options
Diffstat (limited to 'src/eurm.ml')
-rw-r--r-- | src/eurm.ml | 38 |
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 | ||
8 | let end_label = "end" | 8 | let end_label = "end" |
9 | 9 | ||
10 | let compile_preprocess = | 10 | let 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 | ||
28 | let build_initial_state eurmcmds = | 31 | let 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 |