Mercurial > hg > sv-dependency-builds

annotate src/fftw-3.3.5/genfft/gen_r2cb.ml @ 84:08ae793730bd

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