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