1(*
2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
3 * Copyright (c) 2003, 2007-14 Matteo Frigo
4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU General Public License for more details.
15 *
16 * You should have received a copy of the GNU General Public License
17 * along with this program; if not, write to the Free Software
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
19 *
20 *)
21
22open Util
23open Genutil
24open C
25
26
27let usage = "Usage: " ^ Sys.argv.(0) ^ " -n <number>"
28
29let urs = ref Stride_variable
30let ucsr = ref Stride_variable
31let ucsi = ref Stride_variable
32let uivs = ref Stride_variable
33let uovs = ref Stride_variable
34let dftIII_flag = ref false
35
36let speclist = [
37  "-with-rs",
38  Arg.String(fun x -> urs := arg_to_stride x),
39  " specialize for given real-array stride";
40
41  "-with-csr",
42  Arg.String(fun x -> ucsr := arg_to_stride x),
43  " specialize for given complex-array real stride";
44
45  "-with-csi",
46  Arg.String(fun x -> ucsi := arg_to_stride x),
47  " specialize for given complex-array imaginary stride";
48
49  "-with-ivs",
50  Arg.String(fun x -> uivs := arg_to_stride x),
51  " specialize for given input vector stride";
52
53  "-with-ovs",
54  Arg.String(fun x -> uovs := arg_to_stride x),
55  " specialize for given output vector stride";
56
57  "-dft-III",
58  Arg.Unit(fun () -> dftIII_flag := true),
59  " produce shifted dftIII-style codelets"
60]
61
62let hcdftIII sign n input =
63  let input' i =
64    if (i mod 2 == 0) then
65      Complex.zero
66    else
67      let i' = (i - 1) / 2 in
68      if (2 * i' < n - 1) then (input i')
69      else if (2 * i' == n - 1) then
70	Complex.real (input i')
71      else
72	Complex.conj (input (n - 1 - i'))
73  in Fft.dft sign (2 * n) input'
74
75let generate n =
76  let ar0 = "R0" and ar1 = "R1" and acr = "Cr" and aci = "Ci"
77  and rs = "rs" and csr = "csr" and csi = "csi"
78  and i = "i" and v = "v"
79  and transform = if !dftIII_flag then hcdftIII else Trig.hdft
80  in
81
82  let sign = !Genutil.sign
83  and name = !Magic.codelet_name in
84
85  let vrs = either_stride (!urs) (C.SVar rs)
86  and vcsr = either_stride (!ucsr) (C.SVar csr)
87  and vcsi = either_stride (!ucsi) (C.SVar csi)
88  in
89
90  let sovs = stride_to_string "ovs" !uovs in
91  let sivs = stride_to_string "ivs" !uivs in
92
93  let locations = unique_array_c n in
94  let input =
95    locative_array_c n
96      (C.array_subscript acr vcsr)
97      (C.array_subscript aci vcsi)
98      locations sivs in
99  let output = transform sign n (load_array_hc n input) in
100  let oloce =
101    locative_array_c n
102      (C.array_subscript ar0 vrs)
103      (C.array_subscript "BUG" vrs)
104      locations sovs
105  and oloco =
106    locative_array_c n
107      (C.array_subscript ar1 vrs)
108      (C.array_subscript "BUG" vrs)
109      locations sovs in
110  let oloc i = if i mod 2 == 0 then oloce (i/2) else oloco ((i-1)/2) in
111  let odag = store_array_r n oloc output in
112  let annot = standard_optimizer odag in
113
114  let body = Block (
115    [Decl ("INT", i)],
116    [For (Expr_assign (CVar i, CVar v),
117	  Binop (" > ", CVar i, Integer 0),
118	  list_to_comma
119	    [Expr_assign (CVar i, CPlus [CVar i; CUminus (Integer 1)]);
120	     Expr_assign (CVar ar0, CPlus [CVar ar0; CVar sovs]);
121	     Expr_assign (CVar ar1, CPlus [CVar ar1; CVar sovs]);
122	     Expr_assign (CVar acr, CPlus [CVar acr; CVar sivs]);
123	     Expr_assign (CVar aci, CPlus [CVar aci; CVar sivs]);
124	     make_volatile_stride (4*n) (CVar rs);
125	     make_volatile_stride (4*n) (CVar csr);
126	     make_volatile_stride (4*n) (CVar csi)
127	   ],
128	  Asch annot)
129   ])
130  in
131
132  let tree =
133    Fcn ((if !Magic.standalone then "void" else "static void"), name,
134	 ([Decl (C.realtypep, ar0);
135	   Decl (C.realtypep, ar1);
136	   Decl (C.realtypep, acr);
137	   Decl (C.realtypep, aci);
138	   Decl (C.stridetype, rs);
139	   Decl (C.stridetype, csr);
140	   Decl (C.stridetype, csi);
141	   Decl ("INT", v);
142	   Decl ("INT", "ivs");
143	   Decl ("INT", "ovs")]),
144	 finalize_fcn body)
145
146  in let desc =
147    Printf.sprintf
148      "static const kr2c_desc desc = { %d, \"%s\", %s, &GENUS };\n\n"
149      n name (flops_of tree)
150
151  and init =
152    (declare_register_fcn name) ^
153    "{" ^
154    "  X(kr2c_register)(p, " ^ name ^ ", &desc);\n" ^
155    "}\n"
156
157  in
158  (unparse tree) ^ "\n" ^ (if !Magic.standalone then "" else desc ^ init)
159
160
161let main () =
162  begin
163    parse speclist usage;
164    print_string (generate (check_size ()));
165  end
166
167let _ = main()
168