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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
(* PRINTER FOR DUMBED-DOWN NETLIST
(the format used by the C simulator)
*)
open Netlist_ast
open Format
(* Alternative program AST format, better corresponding to the dumb syntax *)
type var_def = {
name : string;
size : int }
type var_id = int
type const_val = bool array
(* keep type binop from netlist_ast *)
type reg_var = { dest : var_id; source : var_id }
type ram_var = { dest : var_id;
addr_size : int; word_size : int;
read_addr : var_id; write_enable : var_id;
write_addr : var_id; data : var_id }
type dumb_exp =
| Dcopy of var_id (* copy a variable - these cannot be eliminated totally *)
| Dnot of var_id
| Dbinop of binop * var_id * var_id
| Dmux of var_id * var_id * var_id
| Drom of int * int * var_id
| Dconcat of var_id * var_id
| Dslice of int * int * var_id
| Dselect of int * var_id
type dumb_equation = var_id * dumb_exp
type dumb_program = {
d_vars : var_def list;
d_inputs : var_id list;
d_outputs : var_id list;
d_regs : reg_var list;
d_rams : ram_var list;
d_eqs : dumb_equation list }
(* Convert a program to a dumb program *)
let mkbinstr a =
let r = String.make (Array.length a) '0' in
for i = 0 to Array.length a - 1 do
if a.(i) then r.[i] <- '1'
done;
r
let const_info a =
"$" ^ (mkbinstr a), Array.length a, a
let make_program_dumb p =
(*
1. Identify constants and create new variables for them,
put them on the variable list
2. Create map from variable identifier to variable ID,
add them to variable list
3. Extract regs and rams into separate list
4. Reformat equation list (replace constants by the
coresponding constant variables)
5. Done.
*)
let next_id = ref 0 in
let vars = ref [] in
let var_map = Hashtbl.create (Env.cardinal p.p_vars) in
(* Extract constants *)
List.iter
(fun (_, eq) ->
let add = function
| Aconst(k) ->
let id, sz, v = const_info k in
if not (Hashtbl.mem var_map id) then begin
vars := { name= id; size= sz }::(!vars);
Hashtbl.add var_map id (!next_id);
next_id := !next_id + 1
end
| _ -> ()
in match eq with
| Earg(a) -> add a
| Enot(a) -> add a
| Ebinop(_, a, b) -> add a; add b
| Emux(a, b, c) -> add a; add b; add c
| Erom(_, _, a) -> add a
| Eram(_, _, a, b, c, d) -> add a; add b; add c; add d
| Econcat(a, b) -> add a; add b
| Eslice(_, _, a) -> add a
| Eselect(_, a) ->add a
| _ -> ())
p.p_eqs;
(* Make ids for variables *)
Env.iter
(fun k v ->
vars := { name = k; size = v }::(!vars);
Hashtbl.add var_map k (!next_id);
next_id := !next_id + 1)
p.p_vars;
let var_id = Hashtbl.find var_map in
let arg_id = function
| Avar(x) -> var_id x
| Aconst(x) ->
let n, _, _ = const_info x in var_id n
in
(* Extract registers *)
let regs, eq2 = List.fold_left
(fun (regs, eqs) (n, eq) ->
match eq with
| Ereg(x) ->
{
dest = var_id n;
source = var_id x;
}::regs, eqs
| _ -> regs, (n, eq)::eqs)
([],[])
p.p_eqs in
(* Extract rams *)
let rams, eq3 = List.fold_left
(fun (rams, eqs) (n, eq) ->
match eq with
| Eram(asz, wsz, ra, we, wa, d) ->
{
dest = var_id n;
addr_size = asz;
word_size = wsz;
read_addr = arg_id ra;
write_enable = arg_id we;
write_addr = arg_id wa;
data = arg_id d;
}::rams, eqs
| _ -> rams, (n, eq)::eqs)
([],[])
eq2 in
(* Replace arguments by variable id's *)
let eqs = List.map
(fun (n, eq) ->
(var_id n, match eq with
| Earg(a) -> Dcopy(arg_id a)
| Enot(a) -> Dnot(arg_id a)
| Ebinop(o, a, b) -> Dbinop(o, arg_id a, arg_id b)
| Emux(a, b, c) -> Dmux(arg_id a, arg_id b, arg_id c)
| Erom(u, v, a) -> Drom(u, v, arg_id a)
| Econcat(a, b) -> Dconcat(arg_id a, arg_id b)
| Eslice(u, v, a) -> Dslice(u, v, arg_id a)
| Eselect(i, a) -> Dselect(i, arg_id a)
| _ -> failwith "This should not happen."))
eq3 in
{
d_vars = List.rev (!vars);
d_inputs = List.map var_id p.p_inputs;
d_outputs = List.map var_id p.p_outputs;
d_regs = regs;
d_rams = rams;
d_eqs = eqs;
}
(* Printer code *)
(* Identifiers *)
let c_copy = 0
let c_not = 1
let c_binop = 2
let c_mux = 3
let c_rom = 4
let c_concat = 5
let c_slice = 6
let c_select = 7
let binop_id = function
| Or -> 0
| Xor -> 1
| And -> 2
| Nand -> 3
let print_dumb_program oc p =
let ff = formatter_of_out_channel oc in
(* print variable list *)
fprintf ff "%d\n" (List.length p.d_vars);
List.iter
(fun v ->
fprintf ff "%d %s\n" v.size v.name)
p.d_vars;
(* print input list *)
fprintf ff "%d" (List.length p.d_inputs);
List.iter (fun k -> fprintf ff " %d" k) p.d_inputs;
fprintf ff "\n";
(* print output list *)
fprintf ff "%d" (List.length p.d_outputs);
List.iter (fun k -> fprintf ff " %d" k) p.d_outputs;
fprintf ff "\n";
(* print register list *)
fprintf ff "%d\n" (List.length p.d_regs);
List.iter (fun (r: reg_var) ->
fprintf ff "%d %d\n" r.dest r.source) p.d_regs;
(* print ram list *)
fprintf ff "%d\n" (List.length p.d_rams);
List.iter (fun r -> fprintf ff "%d %d %d %d %d %d %d\n"
r.dest r.addr_size r.word_size r.read_addr r.write_enable
r.write_addr r.data) p.d_rams;
(* print equation list *)
fprintf ff "%d\n" (List.length p.d_eqs);
List.iter (fun (n, e) ->
fprintf ff "%d " n; match e with
| Dcopy(x) -> fprintf ff "%d %d\n" c_copy x
| Dnot(x) -> fprintf ff "%d %d\n" c_not x
| Dbinop(o, a, b) -> fprintf ff "%d %d %d %d\n" c_binop (binop_id o) a b
| Dmux(a, b, c) -> fprintf ff "%d %d %d %d\n" c_mux a b c
| Drom(u, v, a) -> fprintf ff "%d %d %d %d\n" c_rom u v a
| Dconcat(a, b) -> fprintf ff "%d %d %d\n" c_concat a b
| Dslice(u, v, a) -> fprintf ff "%d %d %d %d\n" c_slice u v a
| Dselect(i, a) -> fprintf ff "%d %d %d\n" c_select i a)
p.d_eqs;
(*flush*)
fprintf ff "@."
let print_program oc p =
print_dumb_program oc (make_program_dumb p)
|