From 6c9cc975a5715f186c00e487c4ed38a221711651 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Thu, 15 Oct 2020 09:25:52 +0100 Subject: Add HTLBlockgen and more scheduling --- src/hls/Schedule.ml | 106 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 64 insertions(+), 42 deletions(-) (limited to 'src/hls/Schedule.ml') diff --git a/src/hls/Schedule.ml b/src/hls/Schedule.ml index 2d9a7c2..7d2d2ea 100644 --- a/src/hls/Schedule.ml +++ b/src/hls/Schedule.ml @@ -42,91 +42,113 @@ let read_process command = Buffer.contents buffer let add_dep i tree deps curr = - match PTree.get curr tree with - | None -> deps - | Some ip -> (ip, i)::deps + match PTree.get curr tree with None -> deps | Some ip -> (ip, i) :: deps let accumulate_deps dfg curr = - let (i, tree, vals) = dfg in + let i, tree, vals = dfg in match curr with - | RBnop -> (i+1, tree, vals) + | RBnop -> (i + 1, tree, vals) | RBop (_, rs, dst) -> - (i+1, - PTree.set dst i tree, - List.append (List.fold_left (add_dep i tree) [] rs) vals) - | _ -> assert false + ( i + 1, + PTree.set dst i tree, + List.append (List.fold_left (add_dep i tree) [] rs) vals ) + | RBload (mem, addr, rs, dst) -> + ( i + 1, + PTree.set dst i tree, + List.append (List.fold_left (add_dep i tree) [] rs) vals ) + | RBstore (mem, addr, rs, dst) -> (i + 1, tree, vals) let assigned_vars vars = function | RBnop -> vars - | RBop (_, _, dst) -> dst::vars - | RBload (_, _, _, dst) -> dst::vars + | RBop (_, _, dst) -> dst :: vars + | RBload (_, _, _, dst) -> dst :: vars | RBstore (_, _, _, _) -> vars (* All the nodes in the DFG have to come after the source of the basic block, and should terminate before the sink of the basic block. After that, there should be constraints for data dependencies between nodes. *) let gather_bb_constraints bb = - let (_, _, edges) = List.fold_left accumulate_deps (0, PTree.empty, []) bb.bb_body in + let _, _, edges = + List.fold_left accumulate_deps (0, PTree.empty, []) bb.bb_body + in match bb.bb_exit with | None -> assert false - | Some e -> - (List.length bb.bb_body, edges, successors_instr e) + | Some e -> (List.length bb.bb_body, edges, successors_instr e) let gen_bb_name s i = sprintf "bb%d%s" (P.to_int i) s + let gen_bb_name_ssrc = gen_bb_name "ssrc" + let gen_bb_name_ssnk = gen_bb_name "ssnk" let gen_var_name s c i = sprintf "v%d%s_%d" (P.to_int i) s c + let gen_var_name_b = gen_var_name "b" + let gen_var_name_e = gen_var_name "e" let print_lt0 = sprintf "%s - %s <= 0;\n" -let print_bb_order i c = - print_lt0 (gen_bb_name_ssnk i) (gen_bb_name_ssrc c) +let print_bb_order i c = print_lt0 (gen_bb_name_ssnk i) (gen_bb_name_ssrc c) let print_src_order i c = - print_lt0 (gen_bb_name_ssrc i) (gen_var_name_b c i) ^ - print_lt0 (gen_var_name_e c i) (gen_bb_name_ssnk i) ^ - sprintf "%s - %s = 1;\n" (gen_var_name_e c i) (gen_var_name_b c i) + print_lt0 (gen_bb_name_ssrc i) (gen_var_name_b c i) + ^ print_lt0 (gen_var_name_e c i) (gen_bb_name_ssnk i) + ^ sprintf "%s - %s = 1;\n" (gen_var_name_e c i) (gen_var_name_b c i) let print_src_type i c = - sprintf "int %s;\n" (gen_var_name_e c i) ^ - sprintf "int %s;\n" (gen_var_name_b c i) + sprintf "int %s;\n" (gen_var_name_e c i) + ^ sprintf "int %s;\n" (gen_var_name_b c i) let print_data_dep_order c (i, j) = print_lt0 (gen_var_name_e i c) (gen_var_name_b j c) let rec gather_cfg_constraints (completed, (bvars, constraints, types)) c curr = - if List.exists (fun x -> P.eq x curr) completed then (completed, (bvars, constraints, types)) - else match PTree.get curr c with + if List.exists (fun x -> P.eq x curr) completed then + (completed, (bvars, constraints, types)) + else + match PTree.get curr c with | None -> assert false | Some (num_iters, edges, next) -> - let constraints' = - constraints ^ - String.concat "" (List.map (print_bb_order curr) next) ^ - String.concat "" (List.map (print_src_order curr) (List.init num_iters (fun x -> x))) ^ - String.concat "" (List.map (print_data_dep_order curr) edges) in - let types' = - types ^ - String.concat "" (List.map (print_src_type curr) (List.init num_iters (fun x -> x))) ^ - sprintf "int %s;\n" (gen_bb_name_ssrc curr) ^ - sprintf "int %s;\n" (gen_bb_name_ssnk curr) in - let bvars' = - List.append (List.map (fun x -> gen_var_name_b x curr) - (List.init num_iters (fun x -> x))) bvars in - let next' = List.filter (fun x -> P.lt x curr) next in - List.fold_left (fun compl curr' -> gather_cfg_constraints compl c curr') - (curr::completed, (bvars', constraints', types')) next' + let constraints' = + constraints + ^ String.concat "" (List.map (print_bb_order curr) next) + ^ String.concat "" + (List.map (print_src_order curr) + (List.init num_iters (fun x -> x))) + ^ String.concat "" (List.map (print_data_dep_order curr) edges) + in + let types' = + types + ^ String.concat "" + (List.map (print_src_type curr) + (List.init num_iters (fun x -> x))) + ^ sprintf "int %s;\n" (gen_bb_name_ssrc curr) + ^ sprintf "int %s;\n" (gen_bb_name_ssnk curr) + in + let bvars' = + List.append + (List.map + (fun x -> gen_var_name_b x curr) + (List.init num_iters (fun x -> x))) + bvars + in + let next' = List.filter (fun x -> P.lt x curr) next in + List.fold_left + (fun compl curr' -> gather_cfg_constraints compl c curr') + (curr :: completed, (bvars', constraints', types')) + next' let rec intersperse s = function | [] -> [] - | [a] -> [a] - | x::xs -> x::s::intersperse s xs + | [ a ] -> [ a ] + | x :: xs -> x :: s :: intersperse s xs let schedule entry (c : code) = let c' = PTree.map1 gather_bb_constraints c in - let (_, (vars, constraints, types)) = gather_cfg_constraints ([], ([], "", "")) c' entry in + let _, (vars, constraints, types) = + gather_cfg_constraints ([], ([], "", "")) c' entry + in let oc = open_out "lpsolve.txt" in fprintf oc "min: "; List.iter (fprintf oc "%s") (intersperse " + " vars); -- cgit