cannam@127: (* cannam@127: * Copyright (c) 1997-1999 Massachusetts Institute of Technology cannam@127: * Copyright (c) 2003, 2007-14 Matteo Frigo cannam@127: * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology cannam@127: * cannam@127: * This program is free software; you can redistribute it and/or modify cannam@127: * it under the terms of the GNU General Public License as published by cannam@127: * the Free Software Foundation; either version 2 of the License, or cannam@127: * (at your option) any later version. cannam@127: * cannam@127: * This program is distributed in the hope that it will be useful, cannam@127: * but WITHOUT ANY WARRANTY; without even the implied warranty of cannam@127: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the cannam@127: * GNU General Public License for more details. cannam@127: * cannam@127: * You should have received a copy of the GNU General Public License cannam@127: * along with this program; if not, write to the Free Software cannam@127: * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA cannam@127: * cannam@127: *) cannam@127: cannam@127: open Util cannam@127: open Genutil cannam@127: open C cannam@127: cannam@127: cannam@127: let usage = "Usage: " ^ Sys.argv.(0) ^ " -n " cannam@127: cannam@127: let uistride = ref Stride_variable cannam@127: let uostride = ref Stride_variable cannam@127: let uivstride = ref Stride_variable cannam@127: let uovstride = ref Stride_variable cannam@127: cannam@127: let speclist = [ cannam@127: "-with-istride", cannam@127: Arg.String(fun x -> uistride := arg_to_stride x), cannam@127: " specialize for given input stride"; cannam@127: cannam@127: "-with-ostride", cannam@127: Arg.String(fun x -> uostride := arg_to_stride x), cannam@127: " specialize for given output stride"; cannam@127: cannam@127: "-with-ivstride", cannam@127: Arg.String(fun x -> uivstride := arg_to_stride x), cannam@127: " specialize for given input vector stride"; cannam@127: cannam@127: "-with-ovstride", cannam@127: Arg.String(fun x -> uovstride := arg_to_stride x), cannam@127: " specialize for given output vector stride" cannam@127: ] cannam@127: cannam@127: let nonstandard_optimizer list_of_buddy_stores dag = cannam@127: let sched = standard_scheduler dag in cannam@127: let annot = Annotate.annotate list_of_buddy_stores sched in cannam@127: let _ = dump_asched annot in cannam@127: annot cannam@127: cannam@127: let generate n = cannam@127: let riarray = "ri" cannam@127: and iiarray = "ii" cannam@127: and roarray = "ro" cannam@127: and ioarray = "io" cannam@127: and istride = "is" cannam@127: and ostride = "os" cannam@127: and i = "i" cannam@127: and v = "v" cannam@127: in cannam@127: cannam@127: let sign = !Genutil.sign cannam@127: and name = !Magic.codelet_name cannam@127: and byvl x = choose_simd x (ctimes (CVar "(2 * VL)", x)) in cannam@127: let ename = expand_name name in cannam@127: cannam@127: let vistride = either_stride (!uistride) (C.SVar istride) cannam@127: and vostride = either_stride (!uostride) (C.SVar ostride) cannam@127: in cannam@127: cannam@127: let sovs = stride_to_string "ovs" !uovstride in cannam@127: let sivs = stride_to_string "ivs" !uivstride in cannam@127: cannam@127: let locations = unique_array_c n in cannam@127: let input = cannam@127: locative_array_c n cannam@127: (C.array_subscript riarray vistride) cannam@127: (C.array_subscript iiarray vistride) cannam@127: locations sivs in cannam@127: let output = Fft.dft sign n (load_array_c n input) in cannam@127: let oloc = cannam@127: locative_array_c n cannam@127: (C.array_subscript roarray vostride) cannam@127: (C.array_subscript ioarray vostride) cannam@127: locations sovs in cannam@127: let list_of_buddy_stores = cannam@127: let k = !Simdmagic.store_multiple in cannam@127: if (k > 1) then cannam@127: if (n mod k == 0) then cannam@127: List.append cannam@127: (List.map cannam@127: (fun i -> List.map (fun j -> (fst (oloc (k * i + j)))) (iota k)) cannam@127: (iota (n / k))) cannam@127: (List.map cannam@127: (fun i -> List.map (fun j -> (snd (oloc (k * i + j)))) (iota k)) cannam@127: (iota (n / k))) cannam@127: else failwith "invalid n for -store-multiple" cannam@127: else [] cannam@127: in cannam@127: cannam@127: let odag = store_array_c n oloc output in cannam@127: let annot = nonstandard_optimizer list_of_buddy_stores odag in cannam@127: cannam@127: let body = Block ( cannam@127: [Decl ("INT", i)], cannam@127: [For (Expr_assign (CVar i, CVar v), cannam@127: Binop (" > ", CVar i, Integer 0), cannam@127: list_to_comma cannam@127: [Expr_assign (CVar i, CPlus [CVar i; CUminus (byvl (Integer 1))]); cannam@127: Expr_assign (CVar riarray, CPlus [CVar riarray; cannam@127: byvl (CVar sivs)]); cannam@127: Expr_assign (CVar iiarray, CPlus [CVar iiarray; cannam@127: byvl (CVar sivs)]); cannam@127: Expr_assign (CVar roarray, CPlus [CVar roarray; cannam@127: byvl (CVar sovs)]); cannam@127: Expr_assign (CVar ioarray, CPlus [CVar ioarray; cannam@127: byvl (CVar sovs)]); cannam@127: make_volatile_stride (4*n) (CVar istride); cannam@127: make_volatile_stride (4*n) (CVar ostride) cannam@127: ], cannam@127: Asch annot) cannam@127: ]) cannam@127: in cannam@127: cannam@127: let tree = cannam@127: Fcn ((if !Magic.standalone then "void" else "static void"), ename, cannam@127: ([Decl (C.constrealtypep, riarray); cannam@127: Decl (C.constrealtypep, iiarray); cannam@127: Decl (C.realtypep, roarray); cannam@127: Decl (C.realtypep, ioarray); cannam@127: Decl (C.stridetype, istride); cannam@127: Decl (C.stridetype, ostride); cannam@127: Decl ("INT", v); cannam@127: Decl ("INT", "ivs"); cannam@127: Decl ("INT", "ovs")]), cannam@127: finalize_fcn body) cannam@127: cannam@127: in let desc = cannam@127: Printf.sprintf cannam@127: "static const kdft_desc desc = { %d, %s, %s, &GENUS, %s, %s, %s, %s };\n" cannam@127: n (stringify name) (flops_of tree) cannam@127: (stride_to_solverparm !uistride) (stride_to_solverparm !uostride) cannam@127: (choose_simd "0" (stride_to_solverparm !uivstride)) cannam@127: (choose_simd "0" (stride_to_solverparm !uovstride)) cannam@127: cannam@127: and init = cannam@127: (declare_register_fcn name) ^ cannam@127: "{" ^ cannam@127: " X(kdft_register)(p, " ^ ename ^ ", &desc);\n" ^ cannam@127: "}\n" cannam@127: cannam@127: in ((unparse tree) ^ "\n" ^ cannam@127: (if !Magic.standalone then "" else desc ^ init)) cannam@127: cannam@127: let main () = cannam@127: begin cannam@127: parse speclist usage; cannam@127: print_string (generate (check_size ())); cannam@127: end cannam@127: cannam@127: let _ = main()