aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/common.mli5
-rw-r--r--src/eurm.ml58
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
44type state = { todo : int } 44type state = {
45 max_reg : int;
46 label_count : int
47}
45 48
46exception Syntax_error 49exception 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
28let compile_stage1 eurmcmds state = eurmcmds, state 28let 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
40let 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
29let compile_stage2 eurmcmds state = eurmcmds, state 80let compile_stage2 eurmcmds state = eurmcmds, state
30let compile_stage3 eurmcmds state = eurmcmds, state 81let compile_stage3 eurmcmds state = eurmcmds, state
31let compile_stage4 eurmcmds state = [URMZero(0)], state 82let compile_stage4 eurmcmds state = [URMZero(0)], state
32 83
33let urm_from_eurm eurmcmds = 84let 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