diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/common.mli | 5 | ||||
-rw-r--r-- | src/eurm.ml | 58 |
2 files changed, 58 insertions, 5 deletions
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 = { | |||
41 | regs : reg list | 41 | regs : reg list |
42 | } | 42 | } |
43 | 43 | ||
44 | type state = { todo : int } | 44 | type state = { |
45 | max_reg : int; | ||
46 | label_count : int | ||
47 | } | ||
45 | 48 | ||
46 | exception Syntax_error | 49 | 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 = | |||
10 | and id_from_name name = match Hashtbl.find_opt label_table name with | 10 | and id_from_name name = match Hashtbl.find_opt label_table name with |
11 | | Some(id) -> id | 11 | | Some(id) -> id |
12 | | None -> let new_id = string_of_int (Hashtbl.length label_table) | 12 | | None -> let new_id = string_of_int (Hashtbl.length label_table) |
13 | in Hashtbl.add label_table name new_id; new_id | 13 | in Hashtbl.add label_table name new_id; new_id |
14 | and aux = function | 14 | and aux = function |
15 | | [] -> [] | 15 | | [] -> [] |
16 | | Comment(_) :: tail -> aux tail | 16 | | Comment(_) :: tail -> aux tail |
@@ -25,15 +25,65 @@ let compile_preprocess = | |||
25 | | any :: tail -> any :: aux tail | 25 | | any :: tail -> any :: aux tail |
26 | in aux | 26 | in aux |
27 | 27 | ||
28 | let compile_stage1 eurmcmds state = eurmcmds, state | 28 | let build_initial_state eurmcmds = |
29 | let max_reg_of_instr = function | ||
30 | | Dec(r) | Inc(r) | Zero(r) | ZeroPredicate(r, _) -> r | ||
31 | | Add(r1, r2) | Copy(r1, r2) | Mult(r1, r2) | Sub(r1, r2) | ||
32 | | EqPredicate(r1, r2, _) | GEqPredicate(r1, r2, _) | GTPredicate(r1, r2, _) | ||
33 | | LEqPredicate(r1, r2, _) | LTPredicate(r1, r2, _) -> max r1 r2 | ||
34 | | _ -> 0 | ||
35 | in { | ||
36 | max_reg = List.fold_left (fun acc instr -> max acc (max_reg_of_instr instr)) 0 eurmcmds; | ||
37 | label_count = List.fold_left (fun acc instr -> acc + (match instr with | Label(_) -> 1 | _ -> 0)) 0 eurmcmds | ||
38 | } | ||
39 | |||
40 | let rec compile_stage1 eurmcmds state = | ||
41 | let transform = function | ||
42 | | Dec(r) -> | ||
43 | let new_reg = state.max_reg + 1 | ||
44 | in [ Zero(new_reg); Inc(new_reg); Sub(r, new_reg) ], | ||
45 | { max_reg = new_reg; label_count = state.label_count } | ||
46 | |||
47 | | GEqPredicate(r1, r2, l) -> | ||
48 | let new_reg = state.max_reg + 1 | ||
49 | in [ Copy(new_reg, r1); Inc(new_reg); GTPredicate(new_reg, r2, l) ], | ||
50 | { max_reg = new_reg; label_count = state.label_count } | ||
51 | |||
52 | | LEqPredicate(r1, r2, l) -> | ||
53 | let new_reg = state.max_reg + 1 | ||
54 | in [ Copy(new_reg, r2); Inc(new_reg); GTPredicate(new_reg, r1, l) ], | ||
55 | { max_reg = new_reg; label_count = state.label_count } | ||
56 | |||
57 | | Mult(r1, r2) -> | ||
58 | let ctr_reg = state.max_reg + 1 and res_reg = state.max_reg + 2 | ||
59 | and start_label = string_of_int (state.label_count + 1) and end_label = string_of_int (state.label_count + 2) | ||
60 | in [ Zero(ctr_reg); Zero(res_reg); Label(start_label); EqPredicate(ctr_reg, r2, end_label); | ||
61 | Add(res_reg, r1); Inc(ctr_reg); Goto(start_label); Label(end_label) ], | ||
62 | { max_reg = state.max_reg + 2; label_count = state.label_count + 2} | ||
63 | |||
64 | | ZeroPredicate(r, l) -> | ||
65 | let new_reg = state.max_reg + 1 | ||
66 | in [ Zero(new_reg); EqPredicate(r, new_reg, l) ], | ||
67 | { max_reg = new_reg; label_count = state.label_count } | ||
68 | |||
69 | | LTPredicate(r1, r2, l) -> [ GTPredicate(r2, r1, l) ], state | ||
70 | | any -> [ any ], state | ||
71 | |||
72 | in match eurmcmds with | ||
73 | | [] -> [], state | ||
74 | | cmd :: tail -> | ||
75 | let substitution, new_state = transform cmd | ||
76 | in let prgm_tail, end_state = compile_stage1 tail new_state | ||
77 | in substitution @ prgm_tail, end_state | ||
78 | |||
79 | |||
29 | let compile_stage2 eurmcmds state = eurmcmds, state | 80 | let compile_stage2 eurmcmds state = eurmcmds, state |
30 | let compile_stage3 eurmcmds state = eurmcmds, state | 81 | let compile_stage3 eurmcmds state = eurmcmds, state |
31 | let compile_stage4 eurmcmds state = [URMZero(0)], state | 82 | let compile_stage4 eurmcmds state = [URMZero(0)], state |
32 | 83 | ||
33 | let urm_from_eurm eurmcmds = | 84 | let urm_from_eurm eurmcmds = |
34 | let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state | 85 | let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state |
35 | and initial_state = 0 | 86 | in (compile_preprocess eurmcmds, build_initial_state eurmcmds) |
36 | in (compile_preprocess eurmcmds, initial_state) | ||
37 | |> chain compile_stage1 | 87 | |> chain compile_stage1 |
38 | |> chain compile_stage2 | 88 | |> chain compile_stage2 |
39 | |> chain compile_stage3 | 89 | |> chain compile_stage3 |