cannam@127
|
1 (*
|
cannam@127
|
2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
|
cannam@127
|
3 * Copyright (c) 2003, 2007-14 Matteo Frigo
|
cannam@127
|
4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
|
cannam@127
|
5 *
|
cannam@127
|
6 * This program is free software; you can redistribute it and/or modify
|
cannam@127
|
7 * it under the terms of the GNU General Public License as published by
|
cannam@127
|
8 * the Free Software Foundation; either version 2 of the License, or
|
cannam@127
|
9 * (at your option) any later version.
|
cannam@127
|
10 *
|
cannam@127
|
11 * This program is distributed in the hope that it will be useful,
|
cannam@127
|
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
|
cannam@127
|
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
cannam@127
|
14 * GNU General Public License for more details.
|
cannam@127
|
15 *
|
cannam@127
|
16 * You should have received a copy of the GNU General Public License
|
cannam@127
|
17 * along with this program; if not, write to the Free Software
|
cannam@127
|
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
cannam@127
|
19 *
|
cannam@127
|
20 *)
|
cannam@127
|
21
|
cannam@127
|
22 open Util
|
cannam@127
|
23 open Genutil
|
cannam@127
|
24 open C
|
cannam@127
|
25
|
cannam@127
|
26
|
cannam@127
|
27 type ditdif = DIT | DIF
|
cannam@127
|
28 let ditdif = ref DIT
|
cannam@127
|
29 let usage = "Usage: " ^ Sys.argv.(0) ^ " -n <number> [ -dit | -dif ]"
|
cannam@127
|
30
|
cannam@127
|
31 let urs = ref Stride_variable
|
cannam@127
|
32 let ums = ref Stride_variable
|
cannam@127
|
33
|
cannam@127
|
34 let speclist = [
|
cannam@127
|
35 "-dit",
|
cannam@127
|
36 Arg.Unit(fun () -> ditdif := DIT),
|
cannam@127
|
37 " generate a DIT codelet";
|
cannam@127
|
38
|
cannam@127
|
39 "-dif",
|
cannam@127
|
40 Arg.Unit(fun () -> ditdif := DIF),
|
cannam@127
|
41 " generate a DIF codelet";
|
cannam@127
|
42
|
cannam@127
|
43 "-with-rs",
|
cannam@127
|
44 Arg.String(fun x -> urs := arg_to_stride x),
|
cannam@127
|
45 " specialize for given i/o stride";
|
cannam@127
|
46
|
cannam@127
|
47 "-with-ms",
|
cannam@127
|
48 Arg.String(fun x -> ums := arg_to_stride x),
|
cannam@127
|
49 " specialize for given ms"
|
cannam@127
|
50 ]
|
cannam@127
|
51
|
cannam@127
|
52 let generate n =
|
cannam@127
|
53 let rioarray = "x"
|
cannam@127
|
54 and rs = "rs"
|
cannam@127
|
55 and twarray = "W"
|
cannam@127
|
56 and m = "m" and mb = "mb" and me = "me" and ms = "ms" in
|
cannam@127
|
57
|
cannam@127
|
58 let sign = !Genutil.sign
|
cannam@127
|
59 and name = !Magic.codelet_name
|
cannam@127
|
60 and byvl x = choose_simd x (ctimes (CVar "VL", x))
|
cannam@127
|
61 and bytwvl x = choose_simd x (ctimes (CVar "TWVL", x))
|
cannam@127
|
62 and bytwvl_vl x = choose_simd x (ctimes (CVar "(TWVL/VL)", x)) in
|
cannam@127
|
63 let ename = expand_name name in
|
cannam@127
|
64
|
cannam@127
|
65 let (bytwiddle, num_twiddles, twdesc) = Twiddle.twiddle_policy 0 true in
|
cannam@127
|
66 let nt = num_twiddles n in
|
cannam@127
|
67
|
cannam@127
|
68 let byw = bytwiddle n sign (twiddle_array nt twarray) in
|
cannam@127
|
69
|
cannam@127
|
70 let vrs = either_stride (!urs) (C.SVar rs) in
|
cannam@127
|
71 let sms = stride_to_string "ms" !ums in
|
cannam@127
|
72
|
cannam@127
|
73 let locations = unique_array_c n in
|
cannam@127
|
74 let iloc =
|
cannam@127
|
75 locative_array_c n
|
cannam@127
|
76 (C.array_subscript rioarray vrs)
|
cannam@127
|
77 (C.array_subscript "BUG" vrs)
|
cannam@127
|
78 locations sms
|
cannam@127
|
79 and oloc =
|
cannam@127
|
80 locative_array_c n
|
cannam@127
|
81 (C.array_subscript rioarray vrs)
|
cannam@127
|
82 (C.array_subscript "BUG" vrs)
|
cannam@127
|
83 locations sms
|
cannam@127
|
84 in
|
cannam@127
|
85 let liloc = load_array_r n iloc in
|
cannam@127
|
86 let fft = Trig.dft_via_rdft in
|
cannam@127
|
87 let output =
|
cannam@127
|
88 match !ditdif with
|
cannam@127
|
89 | DIT -> array n (fft sign n (byw liloc))
|
cannam@127
|
90 | DIF -> array n (byw (fft sign n liloc))
|
cannam@127
|
91 in
|
cannam@127
|
92 let odag = store_array_r n oloc output in
|
cannam@127
|
93 let annot = standard_optimizer odag in
|
cannam@127
|
94
|
cannam@127
|
95 let vm = CVar m and vmb = CVar mb and vme = CVar me in
|
cannam@127
|
96
|
cannam@127
|
97 let body = Block (
|
cannam@127
|
98 [Decl ("INT", m);
|
cannam@127
|
99 Decl (C.realtypep, rioarray)],
|
cannam@127
|
100 [Stmt_assign (CVar rioarray,
|
cannam@127
|
101 CVar (if (sign < 0) then "ri" else "ii"));
|
cannam@127
|
102 For (list_to_comma
|
cannam@127
|
103 [Expr_assign (vm, vmb);
|
cannam@127
|
104 Expr_assign (CVar twarray,
|
cannam@127
|
105 CPlus [CVar twarray;
|
cannam@127
|
106 ctimes (vmb,
|
cannam@127
|
107 bytwvl_vl (Integer nt))])],
|
cannam@127
|
108 Binop (" < ", vm, vme),
|
cannam@127
|
109 list_to_comma
|
cannam@127
|
110 [Expr_assign (vm, CPlus [vm; byvl (Integer 1)]);
|
cannam@127
|
111 Expr_assign (CVar rioarray, CPlus [CVar rioarray;
|
cannam@127
|
112 byvl (CVar sms)]);
|
cannam@127
|
113 Expr_assign (CVar twarray, CPlus [CVar twarray;
|
cannam@127
|
114 bytwvl (Integer nt)]);
|
cannam@127
|
115 make_volatile_stride n (CVar rs)
|
cannam@127
|
116 ],
|
cannam@127
|
117 Asch annot)])
|
cannam@127
|
118 in
|
cannam@127
|
119
|
cannam@127
|
120 let tree =
|
cannam@127
|
121 Fcn (((if !Magic.standalone then "" else "static ") ^ "void"),
|
cannam@127
|
122 ename,
|
cannam@127
|
123 [Decl (C.realtypep, "ri");
|
cannam@127
|
124 Decl (C.realtypep, "ii");
|
cannam@127
|
125 Decl (C.constrealtypep, twarray);
|
cannam@127
|
126 Decl (C.stridetype, rs);
|
cannam@127
|
127 Decl ("INT", mb);
|
cannam@127
|
128 Decl ("INT", me);
|
cannam@127
|
129 Decl ("INT", ms)],
|
cannam@127
|
130 finalize_fcn body)
|
cannam@127
|
131 in
|
cannam@127
|
132 let twinstr =
|
cannam@127
|
133 Printf.sprintf "static const tw_instr twinstr[] = %s;\n\n"
|
cannam@127
|
134 (twinstr_to_string "VL" (twdesc n))
|
cannam@127
|
135 and desc =
|
cannam@127
|
136 Printf.sprintf
|
cannam@127
|
137 "static const ct_desc desc = {%d, %s, twinstr, &GENUS, %s, %s, %s, %s};\n\n"
|
cannam@127
|
138 n (stringify name) (flops_of tree)
|
cannam@127
|
139 (stride_to_solverparm !urs) "0"
|
cannam@127
|
140 (stride_to_solverparm !ums)
|
cannam@127
|
141 and register =
|
cannam@127
|
142 match !ditdif with
|
cannam@127
|
143 | DIT -> "X(kdft_dit_register)"
|
cannam@127
|
144 | DIF -> "X(kdft_dif_register)"
|
cannam@127
|
145
|
cannam@127
|
146 in
|
cannam@127
|
147 let init =
|
cannam@127
|
148 "\n" ^
|
cannam@127
|
149 twinstr ^
|
cannam@127
|
150 desc ^
|
cannam@127
|
151 (declare_register_fcn name) ^
|
cannam@127
|
152 (Printf.sprintf "{\n%s(p, %s, &desc);\n}" register ename)
|
cannam@127
|
153 in
|
cannam@127
|
154
|
cannam@127
|
155 (unparse tree) ^ "\n" ^ (if !Magic.standalone then "" else init)
|
cannam@127
|
156
|
cannam@127
|
157
|
cannam@127
|
158 let main () =
|
cannam@127
|
159 begin
|
cannam@127
|
160 Simdmagic.simd_mode := true;
|
cannam@127
|
161 parse (speclist @ Twiddle.speclist) usage;
|
cannam@127
|
162 print_string (generate (check_size ()));
|
cannam@127
|
163 end
|
cannam@127
|
164
|
cannam@127
|
165 let _ = main()
|