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 <number>"
cannam@127: 
cannam@127: let urs = ref Stride_variable
cannam@127: let ucsr = ref Stride_variable
cannam@127: let ucsi = ref Stride_variable
cannam@127: let uivs = ref Stride_variable
cannam@127: let uovs = ref Stride_variable
cannam@127: let dftII_flag = ref false
cannam@127: 
cannam@127: let speclist = [
cannam@127:   "-with-rs",
cannam@127:   Arg.String(fun x -> urs := arg_to_stride x),
cannam@127:   " specialize for given real-array stride";
cannam@127: 
cannam@127:   "-with-csr",
cannam@127:   Arg.String(fun x -> ucsr := arg_to_stride x),
cannam@127:   " specialize for given complex-array real stride";
cannam@127: 
cannam@127:   "-with-csi",
cannam@127:   Arg.String(fun x -> ucsi := arg_to_stride x),
cannam@127:   " specialize for given complex-array imaginary stride";
cannam@127: 
cannam@127:   "-with-ivs",
cannam@127:   Arg.String(fun x -> uivs := arg_to_stride x),
cannam@127:   " specialize for given input vector stride";
cannam@127: 
cannam@127:   "-with-ovs",
cannam@127:   Arg.String(fun x -> uovs := arg_to_stride x),
cannam@127:   " specialize for given output vector stride";
cannam@127: 
cannam@127:   "-dft-II",
cannam@127:   Arg.Unit(fun () -> dftII_flag := true),
cannam@127:   " produce shifted dftII-style codelets"
cannam@127: ] 
cannam@127: 
cannam@127: let rdftII sign n input =
cannam@127:   let input' i = if i < n then input i else Complex.zero in
cannam@127:   let f = Fft.dft sign (2 * n) input' in
cannam@127:   let g i = f (2 * i + 1)
cannam@127:   in fun i -> 
cannam@127:     if (i < n - i) then g i
cannam@127:     else if (2 * i + 1 == n) then Complex.real (g i)
cannam@127:     else Complex.zero
cannam@127: 
cannam@127: let generate n =
cannam@127:   let ar0 = "R0" and ar1 = "R1" and acr = "Cr" and aci = "Ci"
cannam@127:   and rs = "rs" and csr = "csr" and csi = "csi" 
cannam@127:   and i = "i" and v = "v"
cannam@127:   and transform = if !dftII_flag then rdftII else Trig.rdft
cannam@127:   in
cannam@127: 
cannam@127:   let sign = !Genutil.sign 
cannam@127:   and name = !Magic.codelet_name in
cannam@127: 
cannam@127:   let vrs = either_stride (!urs) (C.SVar rs)
cannam@127:   and vcsr = either_stride (!ucsr) (C.SVar csr)
cannam@127:   and vcsi = either_stride (!ucsi) (C.SVar csi)
cannam@127:   in
cannam@127: 
cannam@127:   let sovs = stride_to_string "ovs" !uovs in
cannam@127:   let sivs = stride_to_string "ivs" !uivs in
cannam@127: 
cannam@127:   let locations = unique_array_c n in
cannam@127:   let inpute = 
cannam@127:     locative_array_c n 
cannam@127:       (C.array_subscript ar0 vrs)
cannam@127:       (C.array_subscript "BUG" vrs)
cannam@127:       locations sivs
cannam@127:   and inputo =
cannam@127:     locative_array_c n 
cannam@127:       (C.array_subscript ar1 vrs)
cannam@127:       (C.array_subscript "BUG" vrs)
cannam@127:       locations sivs
cannam@127:   in
cannam@127:   let input i = if i mod 2 == 0 then inpute (i/2) else inputo ((i-1)/2) in
cannam@127:   let output = transform sign n (load_array_r n input) in
cannam@127:   let oloc = 
cannam@127:     locative_array_c n 
cannam@127:       (C.array_subscript acr vcsr)
cannam@127:       (C.array_subscript aci vcsi)
cannam@127:       locations sovs in
cannam@127:   let odag = store_array_hc n oloc output in
cannam@127:   let annot = standard_optimizer 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 (Integer 1)]);
cannam@127: 	     Expr_assign (CVar ar0, CPlus [CVar ar0; CVar sivs]);
cannam@127: 	     Expr_assign (CVar ar1, CPlus [CVar ar1; CVar sivs]);
cannam@127: 	     Expr_assign (CVar acr, CPlus [CVar acr; CVar sovs]);
cannam@127: 	     Expr_assign (CVar aci, CPlus [CVar aci; CVar sovs]);
cannam@127: 	     make_volatile_stride (4*n) (CVar rs);
cannam@127: 	     make_volatile_stride (4*n) (CVar csr);
cannam@127: 	     make_volatile_stride (4*n) (CVar csi)
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"), name,
cannam@127: 	 ([Decl (C.realtypep, ar0);
cannam@127: 	   Decl (C.realtypep, ar1);
cannam@127: 	   Decl (C.realtypep, acr);
cannam@127: 	   Decl (C.realtypep, aci);
cannam@127: 	   Decl (C.stridetype, rs);
cannam@127: 	   Decl (C.stridetype, csr);
cannam@127: 	   Decl (C.stridetype, csi);
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 kr2c_desc desc = { %d, \"%s\", %s, &GENUS };\n\n"
cannam@127:       n name (flops_of tree) 
cannam@127: 
cannam@127:   and init =
cannam@127:     (declare_register_fcn name) ^
cannam@127:     "{" ^
cannam@127:     "  X(kr2c_register)(p, " ^ name ^ ", &desc);\n" ^
cannam@127:     "}\n"
cannam@127: 
cannam@127:   in
cannam@127:   (unparse tree) ^ "\n" ^ (if !Magic.standalone then "" else desc ^ init)
cannam@127: 
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()