1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
(*
* UPEM / L3 / Functional programming / Project: URM
* Pacien TRAN-GIRARD, Adam NAILI
*)
open Common
let end_label = "end"
let compile_preprocess cmd_list =
let rec id_from_name tbl name = string_of_int (List.assoc name tbl)
and build_label_table cmd_list =
List.filter (fun cmd -> match cmd with | Label(_) -> true | _ -> false) cmd_list
|> List.mapi (fun id cmd -> match cmd with | Label(name) -> (name, id) | _ -> failwith "Unexpected state")
and rewrite_label tbl = function
| Label(name) -> Label(id_from_name tbl name)
| EqPredicate(i, j, name) -> EqPredicate(i, j, id_from_name tbl name)
| GEqPredicate(i, j, name) -> GEqPredicate(i, j, id_from_name tbl name)
| GTPredicate(i, j, name) -> GTPredicate(i, j, id_from_name tbl name)
| LEqPredicate(i, j, name) -> LEqPredicate(i, j, id_from_name tbl name)
| LTPredicate(i, j, name) -> LTPredicate(i, j, id_from_name tbl name)
| ZeroPredicate(i, name) -> ZeroPredicate(i, id_from_name tbl name)
| Goto(name) -> Goto(id_from_name tbl name)
| any -> any
and rewrite_labels tbl = function
| [] -> [ Label(end_label) ]
| any :: tail -> rewrite_label tbl any :: rewrite_labels tbl tail
in let cmds = List.filter (fun cmd -> match cmd with | Comment(_) -> false | _ -> true) cmd_list
in rewrite_labels (build_label_table cmds) cmds
let build_initial_state eurmcmds =
let max_reg_of_instr = function
| Dec(r) | Inc(r) | Zero(r) | ZeroPredicate(r, _) -> r
| Add(r1, r2) | Copy(r1, r2) | Mult(r1, r2) | Sub(r1, r2)
| EqPredicate(r1, r2, _) | GEqPredicate(r1, r2, _) | GTPredicate(r1, r2, _)
| LEqPredicate(r1, r2, _) | LTPredicate(r1, r2, _) -> max r1 r2
| _ -> 0
in
{ max_reg = List.fold_left (fun acc instr -> max acc (max_reg_of_instr instr)) 0 eurmcmds;
label_count = List.fold_left (fun acc instr -> acc + (match instr with | Label(_) -> 1 | _ -> 0)) 0 eurmcmds;
label_table = [] }
let add_reg_label state new_regs new_labels =
{ max_reg = state.max_reg + new_regs;
label_count = state.label_count + new_labels;
label_table = state.label_table }
let put_labels state tbl =
{ max_reg = state.max_reg;
label_count = state.label_count;
label_table = tbl }
let make_reg state offset = state.max_reg + offset
let make_label state offset = string_of_int (state.label_count + offset)
let rec apply_transform transform_func state = function
| [] -> [], state
| cmd :: tail ->
let substitution, new_state = transform_func state cmd
in let prgm_tail, end_state = apply_transform transform_func new_state tail
in substitution @ prgm_tail, end_state
let compile_stage1 eurmcmds state =
let transform state = function
| Dec(r) ->
let new_reg = make_reg state 1
in [ Zero(new_reg); Inc(new_reg); Sub(r, new_reg) ],
add_reg_label state 1 0
| GEqPredicate(r1, r2, l) ->
let new_reg = make_reg state 1
in [ Copy(new_reg, r1); Inc(new_reg); GTPredicate(new_reg, r2, l) ],
add_reg_label state 1 0
| LEqPredicate(r1, r2, l) ->
let new_reg = make_reg state 1
in [ Copy(new_reg, r2); Inc(new_reg); GTPredicate(new_reg, r1, l) ],
add_reg_label state 1 0
| Mult(r1, r2) ->
let ctr_reg = make_reg state 1 and res_reg = make_reg state 2
and start_label = make_label state 1 and end_label = make_label state 2
in [ Zero(ctr_reg); Zero(res_reg); Label(start_label); EqPredicate(ctr_reg, r2, end_label);
Add(res_reg, r1); Inc(ctr_reg); Goto(start_label); Label(end_label); Copy(r1, res_reg) ],
add_reg_label state 2 2
| ZeroPredicate(r, l) ->
let new_reg = make_reg state 1
in [ Zero(new_reg); EqPredicate(r, new_reg, l) ],
add_reg_label state 1 0
| LTPredicate(r1, r2, l) -> [ GTPredicate(r2, r1, l) ], state
| any -> [ any ], state
in apply_transform (transform) state eurmcmds
let compile_stage2 eurmcmds state =
let transform state = function
| Add(r1, r2) ->
let ctr_reg = make_reg state 1
and start_label = make_label state 1 and end_label = make_label state 2
in [ Zero(ctr_reg); Label(start_label); EqPredicate(ctr_reg, r2, end_label);
Inc(r1); Inc(ctr_reg); Goto(start_label); Label(end_label) ],
add_reg_label state 1 2
| GTPredicate(r1, r2, l) ->
let aux_reg = make_reg state 1
and start_label = make_label state 1 and end_label = make_label state 2
in [ Zero(aux_reg); Label(start_label); EqPredicate(aux_reg, r1, end_label); EqPredicate(aux_reg, r2, l);
Inc(aux_reg); Goto(start_label); Label(end_label) ],
add_reg_label state 1 2
| Sub(r1, r2) ->
let diff_reg = make_reg state 1 and aux1_reg = make_reg state 2 and aux2_reg = make_reg state 3
and start_label = make_label state 1 and end_label = make_label state 2
and error_label = make_label state 3
in [ Zero(diff_reg); Copy(aux1_reg, r1); Copy(aux2_reg, r2); Label(start_label);
EqPredicate(aux1_reg, r2, error_label); EqPredicate(aux2_reg, r1, end_label);
Inc(diff_reg); Inc(aux1_reg); Inc(aux2_reg); Goto(start_label);
Label(error_label); Quit; Label(end_label); Copy(r1, diff_reg) ],
add_reg_label state 3 3
| Quit -> [ Goto(end_label) ], state
| any -> [ any ], state
in apply_transform (transform) state eurmcmds
let compile_stage3 eurmcmds state =
let transform state = function
| Goto(lbl) ->
let dummy_reg = make_reg state 1
in [ Zero(dummy_reg); EqPredicate(dummy_reg, dummy_reg, lbl) ],
add_reg_label state 1 0
| any -> [ any ], state
in apply_transform (transform) state eurmcmds
let compile_stage4 eurmcmds state =
let build_label_table state eurmcmds =
List.mapi (fun lineno cmd -> (cmd, lineno)) eurmcmds
|> List.filter (fun (cmd, _) -> match cmd with | Label(_) -> true | _ -> false)
|> List.map (fun (cmd, lineno) -> match cmd with | Label(lbl) -> (lbl, lineno) | _ -> failwith "Unexpected state")
|> put_labels state
and lineno_from_label state lbl = List.assoc lbl state.label_table
in let transform state = function
| Inc(r) -> [ URMSucc(r) ], state
| Zero(r) -> [ URMZero(r) ], state
| Copy(r1, r2) -> [ URMCopy(r1, r2) ], state
| EqPredicate(r1, r2, lbl) -> [ URMJump(r1, r2, lineno_from_label state lbl) ], state
| Label(_) ->
let dummy_reg = make_reg state 1
in [ URMZero(dummy_reg) ], add_reg_label state 1 0
| _ -> failwith "Invalid_argument"
in apply_transform (transform) (build_label_table state eurmcmds) eurmcmds
let urm_from_eurm eurmcmds =
let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state
in (compile_preprocess eurmcmds, build_initial_state eurmcmds)
|> chain compile_stage1
|> chain compile_stage2
|> chain compile_stage3
|> chain compile_stage4
|> fst
|