From 1e5b58007da3be94755b017004cd5fe484ccbed7 Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Tue, 17 Dec 2013 11:37:54 +0100 Subject: Tabs to spaces ; deleted Caml simulator (useless anyways) --- sched/graph.ml | 48 ++--- sched/main.ml | 38 ++-- sched/netlist_dumb.ml | 372 ++++++++++++++++----------------- sched/scheduler.ml | 130 ++++++------ sched/simplify.ml | 568 +++++++++++++++++++++++++------------------------- 5 files changed, 578 insertions(+), 578 deletions(-) (limited to 'sched') diff --git a/sched/graph.ml b/sched/graph.ml index 08762a1..d5f34a9 100644 --- a/sched/graph.ml +++ b/sched/graph.ml @@ -32,29 +32,29 @@ let find_roots g = List.filter (fun n -> n.n_linked_by = []) g.g_nodes let has_cycle g = - clear_marks g; - let rec visit n = - match n.n_mark with - | InProgress -> true - | Visited -> false - | NotVisited -> - n.n_mark <- InProgress; - let ret = List.fold_left (fun x n -> x || (visit n)) false n.n_link_to in - n.n_mark <- Visited; - 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 + clear_marks g; + let rec visit n = + match n.n_mark with + | InProgress -> true + | Visited -> false + | NotVisited -> + n.n_mark <- InProgress; + let ret = List.fold_left (fun x n -> x || (visit n)) false n.n_link_to in + n.n_mark <- Visited; + 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 let topological g = - 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 n) [] g.g_nodes - in clear_marks g; List.rev ret + 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 n) [] g.g_nodes + in clear_marks g; List.rev ret diff --git a/sched/main.ml b/sched/main.ml index c8ea58e..326a2bd 100644 --- a/sched/main.ml +++ b/sched/main.ml @@ -7,14 +7,14 @@ let compile filename = try let p = Netlist.read_file filename in let out_name = (Filename.chop_suffix filename ".net") ^ ".snet" in - let dumb_out_name = (Filename.chop_suffix filename ".net") ^ ".dumb" in + let dumb_out_name = (Filename.chop_suffix filename ".net") ^ ".dumb" in let out_opt_name = (Filename.chop_suffix filename ".net") ^ "_opt.snet" in - let dumb_opt_out_name = (Filename.chop_suffix filename ".net") ^ "_opt.dumb" in - let q, q_opt = ref p, ref p 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 := Scheduler.schedule p; - q_opt := Simplify.simplify p + q := Scheduler.schedule p; + q_opt := Simplify.simplify p with | Scheduler.Combinational_cycle -> Format.eprintf "The netlist has a combinatory cycle.@."; @@ -23,24 +23,24 @@ let compile filename = let out = open_out out_name in Netlist_printer.print_program out !q; - close_out out; - let dumb_out = open_out dumb_out_name in - Netlist_dumb.print_program dumb_out !q; - close_out dumb_out; + close_out out; + let dumb_out = open_out dumb_out_name in + Netlist_dumb.print_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_dumb.print_program dumb_opt_out !q_opt; - close_out dumb_opt_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_dumb.print_program dumb_opt_out !q_opt; + close_out dumb_opt_out; if !simulate then ( let simulator = if !number_steps = -1 then - !sim_path + !sim_path else - !sim_path ^ " -n " ^ (string_of_int !number_steps) + !sim_path ^ " -n " ^ (string_of_int !number_steps) in ignore (Unix.system (simulator^" "^(if !dumb_down then dumb_out_name else out_name))) ) @@ -50,8 +50,8 @@ let compile filename = let main () = Arg.parse ["-s", Arg.Set simulate, "Launch the simulator"; - "-sim", Arg.Set_string sim_path, "Path to the circuit simulator"; - "-d", Arg.Set dumb_down, "Pass the dumbed-down netlist to the simulator (for the C simulator)"; + "-sim", Arg.Set_string sim_path, "Path to the circuit simulator"; + "-d", Arg.Set dumb_down, "Pass the dumbed-down netlist to the simulator (for the C simulator)"; "-n", Arg.Set_int number_steps, "Number of steps to simulate"] compile "" diff --git a/sched/netlist_dumb.ml b/sched/netlist_dumb.ml index 01c187b..646787e 100644 --- a/sched/netlist_dumb.ml +++ b/sched/netlist_dumb.ml @@ -1,5 +1,5 @@ (* PRINTER FOR DUMBED-DOWN NETLIST - (the format used by the C simulator) + (the format used by the C simulator) *) open Netlist_ast @@ -8,165 +8,165 @@ open Format (* Alternative program AST format, better corresponding to the dumb syntax *) type var_def = { - name : string; - size : int } + name : string; + size : int } type var_id = int type const_val = bool array (* keep type binop from netlist_ast *) type reg_var = { reg_dest : var_id; source : var_id } type ram_var = { ram_id : int; - addr_size : int; word_size : int; - write_enable : var_id; - write_addr : var_id; data : var_id } + addr_size : int; word_size : int; + 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 - | Dreadram of int * var_id + | 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 + | Dreadram 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 } + 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 *) +(* 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 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 + "$" ^ (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 *) - let add_var n = - if not (Hashtbl.mem var_map n) then begin - vars := { name = n; size = Env.find n p.p_vars }::(!vars); - Hashtbl.add var_map n (!next_id); - next_id := !next_id + 1 - end - in - List.iter add_var p.p_inputs; - List.iter (fun (n, _) -> add_var n) p.p_eqs; - Env.iter (fun n _ -> add_var n) 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) -> - { - reg_dest = var_id n; - source = var_id x; - }::regs, eqs - | _ -> regs, (n, eq)::eqs) - ([],[]) - p.p_eqs in - (* Extract rams, replace arguments by variable id's *) - let ram_id = ref 0 in - let rams, eq3 = List.fold_left - (fun (rams, eqs) (n, eq) -> - let ram2 = ref None in - let eq2 = match eq with - | Eram(asz, wsz, ra, we, wa, d) -> - ram_id := !ram_id + 1; - ram2 := Some({ - ram_id = !ram_id - 1; - addr_size = asz; - word_size = wsz; - write_enable = arg_id we; - write_addr = arg_id wa; - data = arg_id d; - }); - Dreadram(!ram_id - 1, arg_id ra) - | 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." - in - (match !ram2 with | None -> rams | Some k -> k::rams), - (var_id n, eq2)::eqs - ) - ([],[]) - eq2 in - - (* Replace arguments by variable id's *) - { - 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 = List.rev rams; - d_eqs = eq3; - } - + (* + 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 *) + let add_var n = + if not (Hashtbl.mem var_map n) then begin + vars := { name = n; size = Env.find n p.p_vars }::(!vars); + Hashtbl.add var_map n (!next_id); + next_id := !next_id + 1 + end + in + List.iter add_var p.p_inputs; + List.iter (fun (n, _) -> add_var n) p.p_eqs; + Env.iter (fun n _ -> add_var n) 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) -> + { + reg_dest = var_id n; + source = var_id x; + }::regs, eqs + | _ -> regs, (n, eq)::eqs) + ([],[]) + p.p_eqs in + (* Extract rams, replace arguments by variable id's *) + let ram_id = ref 0 in + let rams, eq3 = List.fold_left + (fun (rams, eqs) (n, eq) -> + let ram2 = ref None in + let eq2 = match eq with + | Eram(asz, wsz, ra, we, wa, d) -> + ram_id := !ram_id + 1; + ram2 := Some({ + ram_id = !ram_id - 1; + addr_size = asz; + word_size = wsz; + write_enable = arg_id we; + write_addr = arg_id wa; + data = arg_id d; + }); + Dreadram(!ram_id - 1, arg_id ra) + | 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." + in + (match !ram2 with | None -> rams | Some k -> k::rams), + (var_id n, eq2)::eqs + ) + ([],[]) + eq2 in + + (* Replace arguments by variable id's *) + { + 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 = List.rev rams; + d_eqs = eq3; + } + (* Printer code *) @@ -182,53 +182,53 @@ let c_select = 7 let c_readram = 8 let binop_id = function - | Or -> 0 - | Xor -> 1 - | And -> 2 - | Nand -> 3 + | 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.reg_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\n" - r.addr_size r.word_size 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 - | Dreadram(i, k) -> fprintf ff "%d %d %d\n" c_readram i k) - p.d_eqs; - (*flush*) - fprintf ff "@." + 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.reg_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\n" + r.addr_size r.word_size 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 + | Dreadram(i, k) -> fprintf ff "%d %d %d\n" c_readram i k) + p.d_eqs; + (*flush*) + fprintf ff "@." let print_program oc p = - print_dumb_program oc (make_program_dumb p) + print_dumb_program oc (make_program_dumb p) diff --git a/sched/scheduler.ml b/sched/scheduler.ml index d079f64..611aab4 100644 --- a/sched/scheduler.ml +++ b/sched/scheduler.ml @@ -5,80 +5,80 @@ module Smap = Map.Make(String) exception Combinational_cycle let read_exp eq = - let add_arg x l = match x with - | Avar(f) -> f::l - | Aconst(_) -> l - in - let aux = function - | Earg(x) -> add_arg x [] - | Ereg(i) -> [] - | Enot(x) -> add_arg x [] - | Ebinop(_, x, y) -> add_arg x (add_arg y []) - | Emux(a, b, c) -> add_arg a (add_arg b (add_arg c [])) - | Erom(_, _, a) -> add_arg a [] - | Eram(_, _, a, b, c, d) -> [] - | Econcat(u, v) -> add_arg u (add_arg v []) - | Eslice(_, _, a) -> add_arg a [] - | Eselect(_, a) -> add_arg a [] - in - aux eq + let add_arg x l = match x with + | Avar(f) -> f::l + | Aconst(_) -> l + in + let aux = function + | Earg(x) -> add_arg x [] + | Ereg(i) -> [] + | Enot(x) -> add_arg x [] + | Ebinop(_, x, y) -> add_arg x (add_arg y []) + | Emux(a, b, c) -> add_arg a (add_arg b (add_arg c [])) + | Erom(_, _, a) -> add_arg a [] + | Eram(_, _, a, b, c, d) -> [] + | Econcat(u, v) -> add_arg u (add_arg v []) + | Eslice(_, _, a) -> add_arg a [] + | Eselect(_, a) -> add_arg a [] + in + aux eq let read_exp_all eq = - let add_arg x l = match x with - | Avar(f) -> f::l - | Aconst(_) -> l - in - let aux = function - | Earg(x) -> add_arg x [] - | Ereg(i) -> [i] - | Enot(x) -> add_arg x [] - | Ebinop(_, x, y) -> add_arg x (add_arg y []) - | Emux(a, b, c) -> add_arg a (add_arg b (add_arg c [])) - | Erom(_, _, a) -> add_arg a [] - | Eram(_, _, a, b, c, d) -> add_arg a (add_arg b (add_arg c (add_arg d []))) - | Econcat(u, v) -> add_arg u (add_arg v []) - | Eslice(_, _, a) -> add_arg a [] - | Eselect(_, a) -> add_arg a [] - in - aux eq + let add_arg x l = match x with + | Avar(f) -> f::l + | Aconst(_) -> l + in + let aux = function + | Earg(x) -> add_arg x [] + | Ereg(i) -> [i] + | Enot(x) -> add_arg x [] + | Ebinop(_, x, y) -> add_arg x (add_arg y []) + | Emux(a, b, c) -> add_arg a (add_arg b (add_arg c [])) + | Erom(_, _, a) -> add_arg a [] + | Eram(_, _, a, b, c, d) -> add_arg a (add_arg b (add_arg c (add_arg d []))) + | Econcat(u, v) -> add_arg u (add_arg v []) + | Eslice(_, _, a) -> add_arg a [] + | Eselect(_, a) -> add_arg a [] + in + aux eq let prog_eq_map p = - List.fold_left - (fun x (vn, eqn) -> Smap.add vn eqn x) - Smap.empty p.p_eqs + 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 - (* Add variables as graph nodes *) - List.iter (fun (k, _) -> Graph.add_node graph k) p.p_eqs; - (* Add dependencies as graph edges *) - List.iter - (fun (n, e) -> List.iter - (fun m -> if Smap.mem m eq_map then Graph.add_edge graph m n else ()) - (read_exp e)) - p.p_eqs; - (* Verify there are no cycles *) - if Graph.has_cycle graph then raise Combinational_cycle; - graph + let graph = Graph.mk_graph() in + (* Add variables as graph nodes *) + List.iter (fun (k, _) -> Graph.add_node graph k) p.p_eqs; + (* Add dependencies as graph edges *) + List.iter + (fun (n, e) -> List.iter + (fun m -> if Smap.mem m eq_map then Graph.add_edge graph m n else ()) + (read_exp e)) + 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 + 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 []; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = p.p_vars; - } + (* 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 []; + 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 c47a9d0..37e4539 100644 --- a/sched/simplify.ml +++ b/sched/simplify.ml @@ -1,17 +1,17 @@ (* SIMPLIFICATION PASSES *) (* - Order of simplifications : - - cascade slices and selects - - transform k = SLICE i j var when var = CONCAT var' var'' - - simplify stupid things (a xor 0 = a, a and 0 = 0, etc.) - transform k = SLICE i i var into k = SELECT i var - - 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 - - topological sort + Order of simplifications : + - cascade slices and selects + - transform k = SLICE i j var when var = CONCAT var' var'' + - simplify stupid things (a xor 0 = a, a and 0 = 0, etc.) + transform k = SLICE i i var into k = SELECT i var + - 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 + - topological sort - TODO : eliminate unused variables. problem : they are hard to identify + TODO : eliminate unused variables. problem : they are hard to identify *) open Netlist_ast @@ -21,321 +21,321 @@ module Smap = Map.Make(String) (* Simplify cascade slicing/selecting *) let cascade_slices p = - let usefull = ref false in - let slices = Hashtbl.create 42 in - let eqs_new = List.map - (fun (n, eq) -> (n, match eq with - | Eslice(u, v, Avar(x)) -> - let dec, nx = - if Hashtbl.mem slices x then begin - Hashtbl.find slices x - end else - (0, x) - in - Hashtbl.add slices n (u + dec, nx); - if nx <> x || dec <> 0 then usefull := true; - Eslice(u + dec, v + dec, Avar(nx)) - | Eselect(u, Avar(x)) -> - begin try - let ku, kx = Hashtbl.find slices x in - usefull := true; - Eselect(ku + u, Avar(kx)) - with - Not_found -> Eselect(u, Avar(x)) - end - | _ -> eq)) - p.p_eqs in - { - p_eqs = eqs_new; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = p.p_vars; - }, !usefull + let usefull = ref false in + let slices = Hashtbl.create 42 in + let eqs_new = List.map + (fun (n, eq) -> (n, match eq with + | Eslice(u, v, Avar(x)) -> + let dec, nx = + if Hashtbl.mem slices x then begin + Hashtbl.find slices x + end else + (0, x) + in + Hashtbl.add slices n (u + dec, nx); + if nx <> x || dec <> 0 then usefull := true; + Eslice(u + dec, v + dec, Avar(nx)) + | Eselect(u, Avar(x)) -> + begin try + let ku, kx = Hashtbl.find slices x in + usefull := true; + Eselect(ku + u, Avar(kx)) + with + Not_found -> Eselect(u, Avar(x)) + end + | _ -> eq)) + p.p_eqs in + { + p_eqs = eqs_new; + p_inputs = p.p_inputs; + p_outputs = p.p_outputs; + p_vars = p.p_vars; + }, !usefull (* If - var = CONCAT a b - x = SLICE i j var - or - y = SELECT i var - then x or y may be simplified + var = CONCAT a b + x = SLICE i j var + or + y = SELECT i var + then x or y may be simplified *) let pass_concat p = - let usefull = ref false in - let concats = Hashtbl.create 42 in - List.iter (fun (n, eq) -> match eq with - | Econcat(x, y) -> - let s1 = match x with - | Aconst(a) -> Array.length a - | Avar(z) -> Env.find z p.p_vars - in let s2 = match y with - | Aconst(a) -> Array.length a - | Avar(z) -> Env.find z p.p_vars - in - Hashtbl.add concats n (x, s1, y, s2) - | _ -> ()) p.p_eqs; - let eqs_new = List.map - (fun (n, eq) -> (n, match eq with - | Eselect(i, Avar(n)) -> - begin try - let (x, s1, y, s2) = Hashtbl.find concats n in - usefull := true; - if i < s1 then - Eselect(i, x) - else - Eselect(i-s1, y) - with Not_found -> eq end - | Eslice(i, j, Avar(n)) -> - begin try - let (x, s1, y, s2) = Hashtbl.find concats n in - if j < s1 then begin - usefull := true; - Eslice(i, j, x) - end else if i >= s1 then begin - usefull := true; - Eslice(i - s1, j - s1, y) - end else eq - with Not_found -> eq end - | _ -> eq)) - p.p_eqs in - { - p_eqs = eqs_new; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = p.p_vars; - }, !usefull - + let usefull = ref false in + let concats = Hashtbl.create 42 in + List.iter (fun (n, eq) -> match eq with + | Econcat(x, y) -> + let s1 = match x with + | Aconst(a) -> Array.length a + | Avar(z) -> Env.find z p.p_vars + in let s2 = match y with + | Aconst(a) -> Array.length a + | Avar(z) -> Env.find z p.p_vars + in + Hashtbl.add concats n (x, s1, y, s2) + | _ -> ()) p.p_eqs; + let eqs_new = List.map + (fun (n, eq) -> (n, match eq with + | Eselect(i, Avar(n)) -> + begin try + let (x, s1, y, s2) = Hashtbl.find concats n in + usefull := true; + if i < s1 then + Eselect(i, x) + else + Eselect(i-s1, y) + with Not_found -> eq end + | Eslice(i, j, Avar(n)) -> + begin try + let (x, s1, y, s2) = Hashtbl.find concats n in + if j < s1 then begin + usefull := true; + Eslice(i, j, x) + end else if i >= s1 then begin + usefull := true; + Eslice(i - s1, j - s1, y) + end else eq + with Not_found -> eq end + | _ -> eq)) + p.p_eqs in + { + p_eqs = eqs_new; + p_inputs = p.p_inputs; + p_outputs = p.p_outputs; + p_vars = p.p_vars; + }, !usefull + (* Simplifies some trivial arithmetic possibilites : - a and 1 = a - a and 0 = 0 - a or 1 = 1 - 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] + a and 1 = a + a and 0 = 0 + a or 1 = 1 + 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 = - let usefull = ref false in - { - p_eqs = List.map - (fun (n, eq) -> - let useless = ref false in - let neq = match eq with - | Ebinop(Or, Aconst([|false|]), x) -> Earg(x) - | Ebinop(Or, Aconst([|true|]), x) -> Earg(Aconst([|true|])) - | Ebinop(Or, x, Aconst([|false|])) -> Earg(x) - | Ebinop(Or, x, Aconst([|true|])) -> Earg(Aconst([|true|])) + let usefull = ref false in + { + p_eqs = List.map + (fun (n, eq) -> + let useless = ref false in + let neq = match eq with + | Ebinop(Or, Aconst([|false|]), x) -> Earg(x) + | Ebinop(Or, Aconst([|true|]), x) -> Earg(Aconst([|true|])) + | Ebinop(Or, x, Aconst([|false|])) -> Earg(x) + | Ebinop(Or, x, Aconst([|true|])) -> Earg(Aconst([|true|])) - | Ebinop(And, Aconst([|false|]), x) -> Earg(Aconst([|false|])) - | Ebinop(And, Aconst([|true|]), x) -> Earg(x) - | Ebinop(And, x, Aconst([|false|])) -> Earg(Aconst([|false|])) - | Ebinop(And, x, Aconst([|true|])) -> Earg(x) + | Ebinop(And, Aconst([|false|]), x) -> Earg(Aconst([|false|])) + | Ebinop(And, Aconst([|true|]), x) -> Earg(x) + | Ebinop(And, x, Aconst([|false|])) -> Earg(Aconst([|false|])) + | Ebinop(And, x, Aconst([|true|])) -> Earg(x) - | Ebinop(Xor, Aconst([|false|]), x) -> Earg(x) - | Ebinop(Xor, x, Aconst([|false|])) -> Earg(x) + | Ebinop(Xor, Aconst([|false|]), x) -> Earg(x) + | Ebinop(Xor, x, Aconst([|false|])) -> Earg(x) - | Eslice(i, j, k) when i = j -> Eselect(i, k) + | Eslice(i, j, k) when i = j -> Eselect(i, k) - | Econcat(Aconst(a), Aconst(b)) -> - Earg(Aconst(Array.append a b)) - - | Eslice(i, j, Aconst(a)) -> - Earg(Aconst(Array.sub a i (j - i + 1))) - - | Eselect(i, Aconst(a)) -> - Earg(Aconst([|a.(i)|])) - - | _ -> useless := true; eq in - if not !useless then usefull := true; - (n, neq)) - p.p_eqs; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = p.p_vars; - }, !usefull + | Econcat(Aconst(a), Aconst(b)) -> + Earg(Aconst(Array.append a b)) + + | Eslice(i, j, Aconst(a)) -> + Earg(Aconst(Array.sub a i (j - i + 1))) + + | Eselect(i, Aconst(a)) -> + Earg(Aconst([|a.(i)|])) + + | _ -> useless := true; eq in + if not !useless then usefull := true; + (n, neq)) + p.p_eqs; + p_inputs = p.p_inputs; + p_outputs = p.p_outputs; + p_vars = p.p_vars; + }, !usefull (* if x is one bit, then : - select 0 x = x + select 0 x = x and same thing with select *) let select_to_id p = - let usefull = ref false in - { - p_eqs = List.map - (fun (n, eq) -> match eq with - | Eselect(0, Avar(id)) when Env.find id p.p_vars = 1 -> - usefull := true; - (n, Earg(Avar(id))) - | Eslice(0, sz, Avar(id)) when Env.find id p.p_vars = sz + 1 -> - usefull := true; - (n, Earg(Avar(id))) - | _ -> (n, eq)) - p.p_eqs; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = p.p_vars; - }, !usefull + let usefull = ref false in + { + p_eqs = List.map + (fun (n, eq) -> match eq with + | Eselect(0, Avar(id)) when Env.find id p.p_vars = 1 -> + usefull := true; + (n, Earg(Avar(id))) + | Eslice(0, sz, Avar(id)) when Env.find id p.p_vars = sz + 1 -> + usefull := true; + (n, Earg(Avar(id))) + | _ -> (n, eq)) + p.p_eqs; + p_inputs = p.p_inputs; + p_outputs = p.p_outputs; + p_vars = p.p_vars; + }, !usefull (* - If a = eqn(v1, v2, ...) and b = eqn(v1, v2, ...) <- the same equation - then say b = a + If a = eqn(v1, v2, ...) and b = eqn(v1, v2, ...) <- the same equation + then say b = a *) let same_eq_simplify p = - let usefull = ref false in - let id_outputs = - (List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_outputs) in - let eq_map = Hashtbl.create 42 in - List.iter - (fun (n, eq) -> if Sset.mem n id_outputs then - Hashtbl.add eq_map eq n) - p.p_eqs; - let simplify_eq (n, eq) = - if Sset.mem n id_outputs then - (n, eq) - else if Hashtbl.mem eq_map eq then begin - usefull := true; - (n, Earg(Avar(Hashtbl.find eq_map eq))) - end else begin - Hashtbl.add eq_map eq n; - (n, eq) - end - in - let eq2 = List.map simplify_eq p.p_eqs in - { - p_eqs = eq2; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = p.p_vars; - }, !usefull + let usefull = ref false in + let id_outputs = + (List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_outputs) in + let eq_map = Hashtbl.create 42 in + List.iter + (fun (n, eq) -> if Sset.mem n id_outputs then + Hashtbl.add eq_map eq n) + p.p_eqs; + let simplify_eq (n, eq) = + if Sset.mem n id_outputs then + (n, eq) + else if Hashtbl.mem eq_map eq then begin + usefull := true; + (n, Earg(Avar(Hashtbl.find eq_map eq))) + end else begin + Hashtbl.add eq_map eq n; + (n, eq) + end + in + let eq2 = List.map simplify_eq p.p_eqs in + { + p_eqs = eq2; + p_inputs = p.p_inputs; + p_outputs = p.p_outputs; + p_vars = p.p_vars; + }, !usefull -(* Replace one specific variable by another argument in the arguments of all equations - (possibly a constant, possibly another variable) +(* Replace one specific variable by another argument in the arguments of all equations + (possibly a constant, possibly another variable) *) let eliminate_var var rep p = - let rep_arg = function - | Avar(i) when i = var -> rep - | k -> k - in - let rep_eqs = List.map - (fun (n, eq) -> (n, match eq with - | Earg(a) -> Earg(rep_arg a) - | Ereg(i) when i = var -> - begin match rep with - | Avar(j) -> Ereg(j) - | Aconst(k) -> Earg(Aconst(k)) - end - | Ereg(j) -> Ereg(j) - | Enot(a) -> Enot(rep_arg a) - | Ebinop(o, a, b) -> Ebinop(o, rep_arg a, rep_arg b) - | Emux(a, b, c) -> Emux(rep_arg a, rep_arg b, rep_arg c) - | Erom(u, v, a) -> Erom(u, v, rep_arg a) - | Eram(u, v, a, b, c, d) -> Eram(u, v, rep_arg a, rep_arg b, rep_arg c, rep_arg d) - | Econcat(a, b) -> Econcat(rep_arg a, rep_arg b) - | Eslice(u, v, a) -> Eslice(u, v, rep_arg a) - | Eselect(u, a) -> Eselect(u, rep_arg a) - )) - p.p_eqs in - { - p_eqs = List.fold_left - (fun x (n, eq) -> - if n = var then x else (n, eq)::x) - [] rep_eqs; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = Env.remove var p.p_vars; - } + let rep_arg = function + | Avar(i) when i = var -> rep + | k -> k + in + let rep_eqs = List.map + (fun (n, eq) -> (n, match eq with + | Earg(a) -> Earg(rep_arg a) + | Ereg(i) when i = var -> + begin match rep with + | Avar(j) -> Ereg(j) + | Aconst(k) -> Earg(Aconst(k)) + end + | Ereg(j) -> Ereg(j) + | Enot(a) -> Enot(rep_arg a) + | Ebinop(o, a, b) -> Ebinop(o, rep_arg a, rep_arg b) + | Emux(a, b, c) -> Emux(rep_arg a, rep_arg b, rep_arg c) + | Erom(u, v, a) -> Erom(u, v, rep_arg a) + | Eram(u, v, a, b, c, d) -> Eram(u, v, rep_arg a, rep_arg b, rep_arg c, rep_arg d) + | Econcat(a, b) -> Econcat(rep_arg a, rep_arg b) + | Eslice(u, v, a) -> Eslice(u, v, rep_arg a) + | Eselect(u, a) -> Eselect(u, rep_arg a) + )) + p.p_eqs in + { + p_eqs = List.fold_left + (fun x (n, eq) -> + if n = var then x else (n, eq)::x) + [] rep_eqs; + p_inputs = p.p_inputs; + p_outputs = p.p_outputs; + p_vars = Env.remove var p.p_vars; + } (* Remove all equations of type : - a = b - a = const - (except if a is an output variable) + a = b + a = const + (except if a is an output variable) *) let rec eliminate_id p = - let id_outputs = - (List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_outputs) in + let id_outputs = + (List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_outputs) in - let rep = - List.fold_left - (fun x (n, eq) -> - if x = None && (not (Sset.mem n id_outputs)) then - match eq with - | Earg(rarg) -> - Some(n, rarg) - | _ -> None - else - x) - None p.p_eqs in - match rep with - | None -> p, false - | Some(n, rep) -> fst (eliminate_id (eliminate_var n rep p)), true + let rep = + List.fold_left + (fun x (n, eq) -> + if x = None && (not (Sset.mem n id_outputs)) then + match eq with + | Earg(rarg) -> + Some(n, rarg) + | _ -> None + else + x) + None p.p_eqs in + match rep with + | None -> p, false + | Some(n, rep) -> fst (eliminate_id (eliminate_var n rep p)), true (* Eliminate dead variables *) let eliminate_dead p = - let rec living basis = - let new_basis = List.fold_left - (fun b2 (n, eq) -> - if Sset.mem n b2 then - List.fold_left - (fun x k -> Sset.add k x) - b2 - (Scheduler.read_exp_all eq) - else - b2) - basis (List.rev p.p_eqs) - in - if Sset.cardinal new_basis > Sset.cardinal basis - then living new_basis - else new_basis - in - let outs = List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_outputs in - let ins = List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_inputs in - let live = living (Sset.union outs ins) in - { - p_eqs = List.filter (fun (n, _) -> Sset.mem n live) p.p_eqs; - p_inputs = p.p_inputs; - p_outputs = p.p_outputs; - p_vars = Env.fold - (fun k s newenv -> - if Sset.mem k live - then Env.add k s newenv - else newenv) - p.p_vars Env.empty - }, (Sset.cardinal live < Env.cardinal p.p_vars) + let rec living basis = + let new_basis = List.fold_left + (fun b2 (n, eq) -> + if Sset.mem n b2 then + List.fold_left + (fun x k -> Sset.add k x) + b2 + (Scheduler.read_exp_all eq) + else + b2) + basis (List.rev p.p_eqs) + in + if Sset.cardinal new_basis > Sset.cardinal basis + then living new_basis + else new_basis + in + let outs = List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_outputs in + let ins = List.fold_left (fun x k -> Sset.add k x) Sset.empty p.p_inputs in + let live = living (Sset.union outs ins) in + { + p_eqs = List.filter (fun (n, _) -> Sset.mem n live) p.p_eqs; + p_inputs = p.p_inputs; + p_outputs = p.p_outputs; + p_vars = Env.fold + (fun k s newenv -> + if Sset.mem k live + then Env.add k s newenv + else newenv) + p.p_vars Env.empty + }, (Sset.cardinal live < Env.cardinal p.p_vars) (* Topological sort *) let topo_sort p = - (Scheduler.schedule p, false) + (Scheduler.schedule p, false) (* Apply all the simplification passes, - in the order given in the header of this file + in the order given in the header of this file *) let rec simplify_with steps p = - let pp, use = List.fold_left - (fun (x, u) (f, n) -> - print_string n; - let xx, uu = f x in - print_string (if uu then " *\n" else "\n"); - (xx, u || uu)) - (p, false) steps in - if use then simplify_with steps pp else pp + let pp, use = List.fold_left + (fun (x, u) (f, n) -> + print_string n; + let xx, uu = f x in + print_string (if uu then " *\n" else "\n"); + (xx, u || uu)) + (p, false) steps in + if use then simplify_with steps pp else pp let simplify p = - let p = simplify_with [ - topo_sort, "topo_sort"; - cascade_slices, "cascade_slices"; - pass_concat, "pass_concat"; - arith_simplify, "arith_simplify"; - select_to_id, "select_to_id"; - same_eq_simplify, "same_eq_simplify"; - eliminate_id, "eliminate_id"; - ] p in - let p = simplify_with [ - eliminate_dead, "eliminate_dead"; - topo_sort, "topo_sort"; (* make sure last step is a topological sort *) - ] p in - p + let p = simplify_with [ + topo_sort, "topo_sort"; + cascade_slices, "cascade_slices"; + pass_concat, "pass_concat"; + arith_simplify, "arith_simplify"; + select_to_id, "select_to_id"; + same_eq_simplify, "same_eq_simplify"; + eliminate_id, "eliminate_id"; + ] p in + let p = simplify_with [ + eliminate_dead, "eliminate_dead"; + topo_sort, "topo_sort"; (* make sure last step is a topological sort *) + ] p in + p -- cgit v1.2.3