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