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 = "xi" cannam@95: and roarray = "xo" 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 "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 sivs = stride_to_string "ivs" !uivstride in cannam@95: let sovs = stride_to_string "ovs" !uovstride in cannam@95: cannam@95: let fft = Trig.dft_via_rdft 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 "BUG" vistride) cannam@95: locations sivs in cannam@95: let output = fft sign n (load_array_r 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 "BUG" 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.map cannam@95: (fun i -> List.map (fun j -> (fst (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: let odag = store_array_r 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: Decl (C.constrealtypep, riarray); cannam@95: Decl (C.realtypep, roarray)], cannam@95: [Stmt_assign (CVar riarray, CVar (if (sign < 0) then "ri" else "ii")); cannam@95: Stmt_assign (CVar roarray, CVar (if (sign < 0) then "ro" else "io")); 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 roarray, CPlus [CVar roarray; cannam@95: byvl (CVar sovs)]); cannam@95: make_volatile_stride (2*n) (CVar istride); cannam@95: make_volatile_stride (2*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, "ri"); cannam@95: Decl (C.constrealtypep, "ii"); cannam@95: Decl (C.realtypep, "ro"); cannam@95: Decl (C.realtypep, "io"); 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 cannam@95: 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: Simdmagic.simd_mode := true; cannam@95: parse speclist usage; cannam@95: print_string (generate (check_size ())); cannam@95: end cannam@95: cannam@95: let _ = main()