diff options
| -rw-r--r-- | README | 9 | ||||
| -rw-r--r-- | sched/graph.ml | 27 | ||||
| -rw-r--r-- | sched/main.ml | 14 | ||||
| -rw-r--r-- | sched/scheduler.ml | 23 | ||||
| -rw-r--r-- | sched/simplify.ml | 80 | ||||
| -rw-r--r-- | tests/Makefile | 2 | ||||
| -rw-r--r-- | tests/clockHMS.mj | 37 |
7 files changed, 137 insertions, 55 deletions
@@ -52,3 +52,12 @@ When represented in binary, we write the bits in the order : /!\ BINARY NUMBERS ARE WRITTEN REVERSE ! + +REFERENCES +---------- + + - Computer organization and design : the hardware/software interface + 4th ed + Chapters 2 to 4 + + diff --git a/sched/graph.ml b/sched/graph.ml index 54128ff..ad4fded 100644 --- a/sched/graph.ml +++ b/sched/graph.ml @@ -44,7 +44,7 @@ let has_cycle g = ret in let ret = List.fold_left (fun x n -> x || (if n.n_mark = Visited then false else visit n)) false g.g_nodes - in clear_marks g; ret;; + in clear_marks g; ret let topological g = clear_marks g; @@ -57,5 +57,28 @@ let topological g = end in let ret = List.fold_left (fun x n -> aux x n) [] g.g_nodes - in clear_marks g; List.rev ret;; + in clear_marks g; List.rev ret +let topological_from_roots g roots = + clear_marks g; + let rec aux acc n = + if n.n_mark = Visited + then acc + else begin + n.n_mark <- Visited; + n.n_label :: (List.fold_left (fun x n -> aux x n) acc n.n_linked_by) + end + in + let ret = List.fold_left + (fun x n -> aux x (node_for_label g n)) [] roots + in + let used = List.fold_left + (fun s n -> + if n.n_mark = Visited then + n.n_label::s + else + s) + [] + g.g_nodes in + clear_marks g; + List.rev ret, used diff --git a/sched/main.ml b/sched/main.ml index a2a4d3b..1b4b9d8 100644 --- a/sched/main.ml +++ b/sched/main.ml @@ -8,10 +8,13 @@ let compile filename = let p = Netlist.read_file filename in let out_name = (Filename.chop_suffix filename ".net") ^ "_sch.net" in let dumb_out_name = (Filename.chop_suffix filename ".net") ^ ".dumb" in - let q = ref p in + let out_opt_name = (Filename.chop_suffix filename ".net") ^ "_sch_opt.net" in + let dumb_opt_out_name = (Filename.chop_suffix filename ".net") ^ "_opt.dumb" in + let q, q_opt = ref p, ref p in begin try - q := (Simplify.simplify (Scheduler.schedule p)) + q := Scheduler.schedule p; + q_opt := Simplify.simplify p with | Scheduler.Combinational_cycle -> Format.eprintf "The netlist has a combinatory cycle.@."; @@ -25,6 +28,13 @@ let compile filename = Netlist_printer.print_dumb_program dumb_out !q; close_out dumb_out; + let out_opt = open_out out_opt_name in + Netlist_printer.print_program out_opt !q_opt; + close_out out_opt; + let dumb_opt_out = open_out dumb_opt_out_name in + Netlist_printer.print_dumb_program dumb_opt_out !q_opt; + close_out dumb_opt_out; + if !simulate then ( let simulator = if !number_steps = -1 then diff --git a/sched/scheduler.ml b/sched/scheduler.ml index 130164b..34ce3aa 100644 --- a/sched/scheduler.ml +++ b/sched/scheduler.ml @@ -21,11 +21,15 @@ let read_exp eq = | Eslice(_, _, a) -> add_arg a [] | Eselect(_, a) -> add_arg a [] in - aux eq;; + aux eq -let schedule p = +let prog_eq_map p = + List.fold_left + (fun x (vn, eqn) -> Smap.add vn eqn x) + Smap.empty p.p_eqs + +let prog_graph p eq_map = let graph = Graph.mk_graph() in - let eq_map = List.fold_left (fun x (vn, eqn) -> Smap.add vn eqn x) Smap.empty p.p_eqs in (* Add variables as graph nodes *) List.iter (fun (k, _) -> Graph.add_node graph k) p.p_eqs; (* Add dependencies as graph edges *) @@ -36,17 +40,26 @@ let schedule p = p.p_eqs; (* Verify there are no cycles *) if Graph.has_cycle graph then raise Combinational_cycle; + graph + +let schedule p = + let eq_map = prog_eq_map p in + let graph = prog_graph p eq_map in + (* Topological sort of graph nodes *) let topo_vars = Graph.topological graph in (* Construct new program with sorted expression list *) { p_eqs = List.fold_right - (fun n x -> if Smap.mem n eq_map then (n, Smap.find n eq_map)::x else x) topo_vars []; + (fun n x -> + if Smap.mem n eq_map then + (n, Smap.find n eq_map)::x + else x) + topo_vars []; p_inputs = p.p_inputs; p_outputs = p.p_outputs; p_vars = p.p_vars; } - ;; diff --git a/sched/simplify.ml b/sched/simplify.ml index 01f7c84..ae5ec65 100644 --- a/sched/simplify.ml +++ b/sched/simplify.ml @@ -8,14 +8,15 @@ - transform k = SELECT 0 var into k = var when var is also one bit - look for variables with same equation, put the second to identity - eliminate k' for each equation k' = k - - eliminate dead equations + - topological sort - These simplifications are run on a topologically sorted list of equations (see main.ml) + TODO : eliminate unused variables. problem : they are hard to identify *) open Netlist_ast module Sset = Set.Make(String) +module Smap = Map.Make(String) (* Simplify cascade slicing/selecting *) let cascade_slices p = @@ -23,15 +24,14 @@ let cascade_slices p = let eqs_new = List.map (fun (n, eq) -> (n, match eq with | Eslice(u, v, Avar(x)) -> - let nu, nx = + let dec, nx = if Hashtbl.mem slices x then begin - let ku, kx = Hashtbl.find slices x in - (ku + u, kx) + Hashtbl.find slices x end else - (u, x) + (0, x) in - Hashtbl.add slices n (nu, nx); - Eslice(nu, v, Avar(nx)) + Hashtbl.add slices n (u + dec, nx); + Eslice(u + dec, v + dec, Avar(nx)) | Eselect(u, Avar(x)) -> begin try let ku, kx = Hashtbl.find slices x in @@ -46,7 +46,7 @@ let cascade_slices p = p_inputs = p.p_inputs; p_outputs = p.p_outputs; p_vars = p.p_vars; - } + }, false (* Simplifies some trivial arithmetic possibilites : a and 1 = a @@ -55,6 +55,9 @@ let cascade_slices p = a or 0 = a a xor 0 = a slice i i x = select i x + concat const const = const.const + slice i j const = const.[i..j] + select i const = const.[i] *) let arith_simplify p = { @@ -75,13 +78,30 @@ let arith_simplify p = | Eslice(i, j, k) when i = j -> (n, Eselect(i, k)) + + | Econcat(Aconst(a), Aconst(b)) -> + let aa = match a with + | VBit(a) -> [| a |] + | VBitArray(a) -> a + in + let ba = match b with + | VBit(a) -> [| a |] + | VBitArray(a) -> a + in + (n, Earg(Aconst(VBitArray(Array.append aa ba)))) + + | Eslice(i, j, Aconst(VBitArray(a))) -> + (n, Earg(Aconst(VBitArray(Array.sub a i (j - i + 1))))) + + | Eselect(i, Aconst(VBitArray(a))) -> + (n, Earg(Aconst(VBit(a.(i))))) | _ -> (n, eq)) p.p_eqs; p_inputs = p.p_inputs; p_outputs = p.p_outputs; p_vars = p.p_vars; - } + }, false (* if x is one bit, then : select 0 x = x @@ -98,7 +118,7 @@ let select_to_id p = p_inputs = p.p_inputs; p_outputs = p.p_outputs; p_vars = p.p_vars; - } + }, false (* If a = eqn(v1, v2, ...) and b = eqn(v1, v2, ...) <- the same equation @@ -128,7 +148,7 @@ let same_eq_simplify p = p_inputs = p.p_inputs; p_outputs = p.p_outputs; p_vars = p.p_vars; - } + }, false (* Replace one specific variable by another argument in the arguments of all equations @@ -192,23 +212,31 @@ let rec eliminate_id p = | None -> p, false | Some(n, rep) -> fst (eliminate_id (eliminate_var n rep p)), true - -(* Eliminate dead equations *) -let eliminate_dead p = - p, false (* TODO *) - (* a bit like a topological sort... *) - +(* Topological sort *) +let topo_sort p = + (Scheduler.schedule p, false) (* Apply all the simplification passes, in the order given in the header of this file *) +let dump_varlist p = + print_string "Eq list:\n"; + List.iter (fun (n, _) -> print_string ("- "^n^"\n")) p.p_eqs + let rec simplify p = - let p1 = cascade_slices p in - let p2 = arith_simplify p1 in - let p3 = select_to_id p2 in - let p4 = same_eq_simplify p3 in - let p5, use5 = eliminate_id p4 in - let p6, use6 = eliminate_dead p5 in - let pp = p6 in - if use5 || use6 then simplify pp else pp + let steps = [ + cascade_slices; + arith_simplify; + select_to_id; + same_eq_simplify; + eliminate_id; + topo_sort; + ] in + let pp, use = List.fold_left + (fun (x, u) f -> + let xx, uu = f x in + dump_varlist xx; + (xx, u || uu)) + (p, false) steps in + if use then simplify pp else pp diff --git a/tests/Makefile b/tests/Makefile index 443e86a..0721dab 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -7,7 +7,7 @@ SIM=../csim/csim %.sim: %.dumb $(SIM) $< -%.dumb %_sch.net: %.net +%.dumb %_sch.net %_opt.dumb %_sch_opt.net: %.net $(SCHED) $< %.net: %.mj diff --git a/tests/clockHMS.mj b/tests/clockHMS.mj index 27f96ea..a25a85c 100644 --- a/tests/clockHMS.mj +++ b/tests/clockHMS.mj @@ -13,19 +13,18 @@ repeat<n>(a) = (x:[n]) where end where fulladder(a,b,c) = (s, r) where - s = (a ^ b) ^ c; - r = (a & b) + ((a ^ b) & c); + s = (a ^ b) ^ c; + r = (a & b) + ((a ^ b) & c); end where adder<n>(a:[n], b:[n], c_in) = (o:[n], c_out) where - if n = 0 then - o = []; - c_out = 0 - else - (s_n, c_n1) = fulladder(a[0], b[0], c_in); - (s_n1, c_out) = adder<n-1>(a[1..], b[1..], c_n1); - o = s_n . s_n1 - end if + if n = 1 then + (o, c_out) = fulladder(a[0], b[0], c_in) + else + (s_n, c_n1) = fulladder(a[0], b[0], c_in); + (s_n1, c_out) = adder<n-1>(a[1..], b[1..], c_n1); + o = s_n . s_n1 + end if end where equal<n, m>(a:[n]) = (eq) where @@ -41,29 +40,29 @@ equal<n, m>(a:[n]) = (eq) where end where reg_n<n>(a:[n]) = (r:[n]) where - if n = 0 then - r = [] + if n = 1 then + r = reg a[0] else - r = (reg a[0]) . (reg_n<n-1>(r[1..])) + r = (reg a[0]) . (reg_n<n-1>(a[1..])) end if end where and_each<n>(a, b:[n]) = (o:[n]) where - if n = 0 then - o = [] + if n = 1 then + o = b[0] and a else o = (b[0] and a) . and_each<n-1>(a, b[1..]) end if end where count_mod<n, m>(in:[n]) = (out:[n]) where - neq = not (equal<n, m>(in)); (incr, carry) = adder<n>(in, 1 . repeat<n-1>(0), 0); + neq = not (equal<n, m>(incr)); out = and_each<n>(neq, incr) end where -main() = (ret:[2],out:[2]) where - out = count_mod<2, 3>(ret); - ret = reg_n<2>(out) +main() = (out:[4],next:[4]) where + next = count_mod<4, 12>(out); + out = reg_n<4>(next) end where |