aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorpacien2018-05-01 01:25:56 +0200
committerpacien2018-05-01 01:25:56 +0200
commit58e4fa622c441a9b832f0656580204a9f5b23e1d (patch)
tree397e59434685ea3393eb51baea7f6961eec17f46 /src
parent37716a32c9aadcca83746bf96bf32b552fa55847 (diff)
downloadurm-58e4fa622c441a9b832f0656580204a9f5b23e1d.tar.gz
Do not reuse Hashtables
Diffstat (limited to 'src')
-rw-r--r--src/common.mli3
-rw-r--r--src/eurm.ml45
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
44type state = { 44type 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
49exception Syntax_error 50exception 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
8let end_label = "end" 8let end_label = "end"
9 9
10let compile_preprocess = 10let 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
30let build_initial_state eurmcmds = 28let 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
41let add_reg_label state new_regs new_labels = 40let 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
45let make_reg state offset = state.max_reg + offset 45let make_reg state offset = state.max_reg + offset
46let make_label state offset = string_of_int (state.label_count + offset) 46let 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
130let compile_stage4 eurmcmds state = 130let 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
145let urm_from_eurm eurmcmds = 144let 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