Chris@19: (*
Chris@19:  * Copyright (c) 1997-1999 Massachusetts Institute of Technology
Chris@19:  * Copyright (c) 2003, 2007-14 Matteo Frigo
Chris@19:  * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
Chris@19:  *
Chris@19:  * This program is free software; you can redistribute it and/or modify
Chris@19:  * it under the terms of the GNU General Public License as published by
Chris@19:  * the Free Software Foundation; either version 2 of the License, or
Chris@19:  * (at your option) any later version.
Chris@19:  *
Chris@19:  * This program is distributed in the hope that it will be useful,
Chris@19:  * but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@19:  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Chris@19:  * GNU General Public License for more details.
Chris@19:  *
Chris@19:  * You should have received a copy of the GNU General Public License
Chris@19:  * along with this program; if not, write to the Free Software
Chris@19:  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
Chris@19:  *
Chris@19:  *)
Chris@19: 
Chris@19: open Util
Chris@19: open Genutil
Chris@19: open C
Chris@19: 
Chris@19: 
Chris@19: let usage = "Usage: " ^ Sys.argv.(0) ^ " -n <number>"
Chris@19: 
Chris@19: let urs = ref Stride_variable
Chris@19: let ucsr = ref Stride_variable
Chris@19: let ucsi = ref Stride_variable
Chris@19: let uivs = ref Stride_variable
Chris@19: let uovs = ref Stride_variable
Chris@19: let dftIII_flag = ref false
Chris@19: 
Chris@19: let speclist = [
Chris@19:   "-with-rs",
Chris@19:   Arg.String(fun x -> urs := arg_to_stride x),
Chris@19:   " specialize for given real-array stride";
Chris@19: 
Chris@19:   "-with-csr",
Chris@19:   Arg.String(fun x -> ucsr := arg_to_stride x),
Chris@19:   " specialize for given complex-array real stride";
Chris@19: 
Chris@19:   "-with-csi",
Chris@19:   Arg.String(fun x -> ucsi := arg_to_stride x),
Chris@19:   " specialize for given complex-array imaginary stride";
Chris@19: 
Chris@19:   "-with-ivs",
Chris@19:   Arg.String(fun x -> uivs := arg_to_stride x),
Chris@19:   " specialize for given input vector stride";
Chris@19: 
Chris@19:   "-with-ovs",
Chris@19:   Arg.String(fun x -> uovs := arg_to_stride x),
Chris@19:   " specialize for given output vector stride";
Chris@19: 
Chris@19:   "-dft-III",
Chris@19:   Arg.Unit(fun () -> dftIII_flag := true),
Chris@19:   " produce shifted dftIII-style codelets"
Chris@19: ] 
Chris@19: 
Chris@19: let hcdftIII sign n input =
Chris@19:   let input' i =
Chris@19:     if (i mod 2 == 0) then
Chris@19:       Complex.zero
Chris@19:     else
Chris@19:       let i' = (i - 1) / 2 in
Chris@19:       if (2 * i' < n - 1) then (input i')
Chris@19:       else if (2 * i' == n - 1) then 
Chris@19: 	Complex.real (input i')
Chris@19:       else 
Chris@19: 	Complex.conj (input (n - 1 - i')) 
Chris@19:   in Fft.dft sign (2 * n) input'
Chris@19: 
Chris@19: let generate n =
Chris@19:   let ar0 = "R0" and ar1 = "R1" and acr = "Cr" and aci = "Ci"
Chris@19:   and rs = "rs" and csr = "csr" and csi = "csi" 
Chris@19:   and i = "i" and v = "v"
Chris@19:   and transform = if !dftIII_flag then hcdftIII else Trig.hdft
Chris@19:   in
Chris@19: 
Chris@19:   let sign = !Genutil.sign 
Chris@19:   and name = !Magic.codelet_name in
Chris@19: 
Chris@19:   let vrs = either_stride (!urs) (C.SVar rs)
Chris@19:   and vcsr = either_stride (!ucsr) (C.SVar csr)
Chris@19:   and vcsi = either_stride (!ucsi) (C.SVar csi)
Chris@19:   in
Chris@19: 
Chris@19:   let sovs = stride_to_string "ovs" !uovs in
Chris@19:   let sivs = stride_to_string "ivs" !uivs in
Chris@19: 
Chris@19:   let locations = unique_array_c n in
Chris@19:   let input = 
Chris@19:     locative_array_c n 
Chris@19:       (C.array_subscript acr vcsr)
Chris@19:       (C.array_subscript aci vcsi)
Chris@19:       locations sivs in
Chris@19:   let output = transform sign n (load_array_hc n input) in
Chris@19:   let oloce = 
Chris@19:     locative_array_c n 
Chris@19:       (C.array_subscript ar0 vrs)
Chris@19:       (C.array_subscript "BUG" vrs)
Chris@19:       locations sovs
Chris@19:   and oloco = 
Chris@19:     locative_array_c n 
Chris@19:       (C.array_subscript ar1 vrs)
Chris@19:       (C.array_subscript "BUG" vrs)
Chris@19:       locations sovs in
Chris@19:   let oloc i = if i mod 2 == 0 then oloce (i/2) else oloco ((i-1)/2) in
Chris@19:   let odag = store_array_r n oloc output in
Chris@19:   let annot = standard_optimizer odag in
Chris@19: 
Chris@19:   let body = Block (
Chris@19:     [Decl ("INT", i)],
Chris@19:     [For (Expr_assign (CVar i, CVar v),
Chris@19: 	  Binop (" > ", CVar i, Integer 0),
Chris@19: 	  list_to_comma 
Chris@19: 	    [Expr_assign (CVar i, CPlus [CVar i; CUminus (Integer 1)]);
Chris@19: 	     Expr_assign (CVar ar0, CPlus [CVar ar0; CVar sovs]);
Chris@19: 	     Expr_assign (CVar ar1, CPlus [CVar ar1; CVar sovs]);
Chris@19: 	     Expr_assign (CVar acr, CPlus [CVar acr; CVar sivs]);
Chris@19: 	     Expr_assign (CVar aci, CPlus [CVar aci; CVar sivs]);
Chris@19: 	     make_volatile_stride (4*n) (CVar rs);
Chris@19: 	     make_volatile_stride (4*n) (CVar csr);
Chris@19: 	     make_volatile_stride (4*n) (CVar csi)
Chris@19: 	   ],
Chris@19: 	  Asch annot)
Chris@19:    ])
Chris@19:   in
Chris@19: 
Chris@19:   let tree =
Chris@19:     Fcn ((if !Magic.standalone then "void" else "static void"), name,
Chris@19: 	 ([Decl (C.realtypep, ar0);
Chris@19: 	   Decl (C.realtypep, ar1);
Chris@19: 	   Decl (C.realtypep, acr);
Chris@19: 	   Decl (C.realtypep, aci);
Chris@19: 	   Decl (C.stridetype, rs);
Chris@19: 	   Decl (C.stridetype, csr);
Chris@19: 	   Decl (C.stridetype, csi);
Chris@19: 	   Decl ("INT", v);
Chris@19: 	   Decl ("INT", "ivs");
Chris@19: 	   Decl ("INT", "ovs")]),
Chris@19: 	 finalize_fcn body)
Chris@19: 
Chris@19:   in let desc = 
Chris@19:     Printf.sprintf 
Chris@19:       "static const kr2c_desc desc = { %d, \"%s\", %s, &GENUS };\n\n"
Chris@19:       n name (flops_of tree) 
Chris@19: 
Chris@19:   and init =
Chris@19:     (declare_register_fcn name) ^
Chris@19:     "{" ^
Chris@19:     "  X(kr2c_register)(p, " ^ name ^ ", &desc);\n" ^
Chris@19:     "}\n"
Chris@19: 
Chris@19:   in
Chris@19:   (unparse tree) ^ "\n" ^ (if !Magic.standalone then "" else desc ^ init)
Chris@19: 
Chris@19: 
Chris@19: let main () =
Chris@19:   begin
Chris@19:     parse speclist usage;
Chris@19:     print_string (generate (check_size ()));
Chris@19:   end
Chris@19: 
Chris@19: let _ = main()