diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/common.mli | 3 | ||||
-rw-r--r-- | src/eurm.ml | 45 |
2 files changed, 24 insertions, 24 deletions
diff --git a/src/common.mli b/src/common.mli index 16ffc87..250a804 100644 --- a/src/common.mli +++ b/src/common.mli | |||
@@ -43,7 +43,8 @@ type urm = { | |||
43 | 43 | ||
44 | type state = { | 44 | type state = { |
45 | max_reg : int; | 45 | max_reg : int; |
46 | label_count : int | 46 | label_count : int; |
47 | label_table : (string, int) Hashtbl.t | ||
47 | } | 48 | } |
48 | 49 | ||
49 | exception Syntax_error | 50 | exception Syntax_error |
diff --git a/src/eurm.ml b/src/eurm.ml index 5cb487b..43d3791 100644 --- a/src/eurm.ml +++ b/src/eurm.ml | |||
@@ -8,24 +8,22 @@ open Common | |||
8 | let end_label = "end" | 8 | let end_label = "end" |
9 | 9 | ||
10 | let compile_preprocess = | 10 | let compile_preprocess = |
11 | let rec label_table = Hashtbl.create 100 | 11 | let rec id_from_name tbl name = match Hashtbl.find_opt tbl name with |
12 | and id_from_name name = match Hashtbl.find_opt label_table name with | ||
13 | | Some(id) -> id | 12 | | Some(id) -> id |
14 | | None -> let new_id = string_of_int (Hashtbl.length label_table) | 13 | | None -> let new_id = string_of_int (Hashtbl.length tbl) in Hashtbl.add tbl name new_id; new_id |
15 | in Hashtbl.add label_table name new_id; new_id | 14 | and aux tbl = function |
16 | and aux = function | ||
17 | | [] -> [ Label(end_label) ] | 15 | | [] -> [ Label(end_label) ] |
18 | | Comment(_) :: tail -> aux tail | 16 | | Comment(_) :: tail -> aux tbl tail |
19 | | Label(name) :: tail -> Label(id_from_name name) :: aux tail | 17 | | Label(name) :: tail -> Label(id_from_name tbl name) :: aux tbl tail |
20 | | EqPredicate(i, j, name) :: tail -> EqPredicate(i, j, id_from_name name) :: aux tail | 18 | | EqPredicate(i, j, name) :: tail -> EqPredicate(i, j, id_from_name tbl name) :: aux tbl tail |
21 | | GEqPredicate(i, j, name) :: tail -> GEqPredicate(i, j, id_from_name name) :: aux tail | 19 | | GEqPredicate(i, j, name) :: tail -> GEqPredicate(i, j, id_from_name tbl name) :: aux tbl tail |
22 | | GTPredicate(i, j, name) :: tail -> GTPredicate(i, j, id_from_name name) :: aux tail | 20 | | GTPredicate(i, j, name) :: tail -> GTPredicate(i, j, id_from_name tbl name) :: aux tbl tail |
23 | | LEqPredicate(i, j, name) :: tail -> LEqPredicate(i, j, id_from_name name) :: aux tail | 21 | | LEqPredicate(i, j, name) :: tail -> LEqPredicate(i, j, id_from_name tbl name) :: aux tbl tail |
24 | | LTPredicate(i, j, name) :: tail -> LTPredicate(i, j, id_from_name name) :: aux tail | 22 | | LTPredicate(i, j, name) :: tail -> LTPredicate(i, j, id_from_name tbl name) :: aux tbl tail |
25 | | ZeroPredicate(i, name) :: tail -> ZeroPredicate(i, id_from_name name) :: aux tail | 23 | | ZeroPredicate(i, name) :: tail -> ZeroPredicate(i, id_from_name tbl name) :: aux tbl tail |
26 | | Goto(name) :: tail -> Goto(id_from_name name) :: aux tail | 24 | | Goto(name) :: tail -> Goto(id_from_name tbl name) :: aux tbl tail |
27 | | any :: tail -> any :: aux tail | 25 | | any :: tail -> any :: aux tbl tail |
28 | in aux | 26 | in aux (Hashtbl.create 100) |
29 | 27 | ||
30 | let build_initial_state eurmcmds = | 28 | let build_initial_state eurmcmds = |
31 | let max_reg_of_instr = function | 29 | let max_reg_of_instr = function |
@@ -36,11 +34,13 @@ let build_initial_state eurmcmds = | |||
36 | | _ -> 0 | 34 | | _ -> 0 |
37 | in | 35 | in |
38 | { max_reg = List.fold_left (fun acc instr -> max acc (max_reg_of_instr instr)) 0 eurmcmds; | 36 | { max_reg = List.fold_left (fun acc instr -> max acc (max_reg_of_instr instr)) 0 eurmcmds; |
39 | label_count = List.fold_left (fun acc instr -> acc + (match instr with | Label(_) -> 1 | _ -> 0)) 0 eurmcmds } | 37 | label_count = List.fold_left (fun acc instr -> acc + (match instr with | Label(_) -> 1 | _ -> 0)) 0 eurmcmds; |
38 | label_table = Hashtbl.create 100 } | ||
40 | 39 | ||
41 | let add_reg_label state new_regs new_labels = | 40 | let add_reg_label state new_regs new_labels = |
42 | { max_reg = state.max_reg + new_regs; | 41 | { max_reg = state.max_reg + new_regs; |
43 | label_count = state.label_count + new_labels } | 42 | label_count = state.label_count + new_labels; |
43 | label_table = state.label_table } | ||
44 | 44 | ||
45 | let make_reg state offset = state.max_reg + offset | 45 | let make_reg state offset = state.max_reg + offset |
46 | let make_label state offset = string_of_int (state.label_count + offset) | 46 | let make_label state offset = string_of_int (state.label_count + offset) |
@@ -128,19 +128,18 @@ let compile_stage3 eurmcmds state = | |||
128 | in apply_transform (transform) state eurmcmds | 128 | in apply_transform (transform) state eurmcmds |
129 | 129 | ||
130 | let compile_stage4 eurmcmds state = | 130 | let compile_stage4 eurmcmds state = |
131 | let label_table = Hashtbl.create 100 | 131 | let build_label_table state eurmcmds= |
132 | in let build_label_table = | 132 | List.iteri (fun lineo cmd -> match cmd with | Label(lbl) -> Hashtbl.add state.label_table lbl lineo | _ -> ()) eurmcmds; state |
133 | List.iteri (fun lineo cmd -> match cmd with | Label(lbl) -> Hashtbl.add label_table lbl lineo | _ -> ()) | ||
134 | in let transform state = function | 133 | in let transform state = function |
135 | | Inc(r) -> [ URMSucc(r) ], state | 134 | | Inc(r) -> [ URMSucc(r) ], state |
136 | | Zero(r) -> [ URMZero(r) ], state | 135 | | Zero(r) -> [ URMZero(r) ], state |
137 | | Copy(r1, r2) -> [ URMCopy(r1, r2) ], state | 136 | | Copy(r1, r2) -> [ URMCopy(r1, r2) ], state |
138 | | EqPredicate(r1, r2, lbl) -> [ URMJump(r1, r2, Hashtbl.find label_table lbl) ], state | 137 | | EqPredicate(r1, r2, lbl) -> [ URMJump(r1, r2, Hashtbl.find state.label_table lbl) ], state |
139 | | Label(_) -> | 138 | | Label(_) -> |
140 | let dummy_reg = make_reg state 1 | 139 | let dummy_reg = make_reg state 1 |
141 | in [ URMZero(dummy_reg) ], add_reg_label state 1 0 | 140 | in [ URMZero(dummy_reg) ], add_reg_label state 1 0 |
142 | | _ -> failwith "Invalid_argument" | 141 | | _ -> failwith "Invalid_argument" |
143 | in build_label_table eurmcmds; apply_transform (transform) state eurmcmds | 142 | in apply_transform (transform) (build_label_table state eurmcmds) eurmcmds |
144 | 143 | ||
145 | let urm_from_eurm eurmcmds = | 144 | let urm_from_eurm eurmcmds = |
146 | let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state | 145 | let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state |