Mercurial > hg > sv-dependency-builds

annotate src/fftw-3.3.5/genfft/gen_r2r.ml @ 77:4edcd14160a5 pa_catalina

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Duplicate for patch testing
author Chris Cannam
date Wed, 30 Oct 2019 11:25:10 +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 (* generation of trigonometric transforms *)
Chris@42 23
Chris@42 24 open Util
Chris@42 25 open Genutil
Chris@42 26 open C
Chris@42 27
Chris@42 28
Chris@42 29 let usage = "Usage: " ^ Sys.argv.(0) ^ " -n <number>"
Chris@42 30
Chris@42 31 let uistride = ref Stride_variable
Chris@42 32 let uostride = ref Stride_variable
Chris@42 33 let uivstride = ref Stride_variable
Chris@42 34 let uovstride = ref Stride_variable
Chris@42 35
Chris@42 36 type mode =
Chris@42 37 | RDFT
Chris@42 38 | HDFT
Chris@42 39 | DHT
Chris@42 40 | REDFT00
Chris@42 41 | REDFT10
Chris@42 42 | REDFT01
Chris@42 43 | REDFT11
Chris@42 44 | RODFT00
Chris@42 45 | RODFT10
Chris@42 46 | RODFT01
Chris@42 47 | RODFT11
Chris@42 48 | NONE
Chris@42 49
Chris@42 50 let mode = ref NONE
Chris@42 51 let normsqr = ref 1
Chris@42 52 let unitary = ref false
Chris@42 53 let noloop = ref false
Chris@42 54
Chris@42 55 let speclist = [
Chris@42 56 "-with-istride",
Chris@42 57 Arg.String(fun x -> uistride := arg_to_stride x),
Chris@42 58 " specialize for given input stride";
Chris@42 59
Chris@42 60 "-with-ostride",
Chris@42 61 Arg.String(fun x -> uostride := arg_to_stride x),
Chris@42 62 " specialize for given output stride";
Chris@42 63
Chris@42 64 "-with-ivstride",
Chris@42 65 Arg.String(fun x -> uivstride := arg_to_stride x),
Chris@42 66 " specialize for given input vector stride";
Chris@42 67
Chris@42 68 "-with-ovstride",
Chris@42 69 Arg.String(fun x -> uovstride := arg_to_stride x),
Chris@42 70 " specialize for given output vector stride";
Chris@42 71
Chris@42 72 "-rdft",
Chris@42 73 Arg.Unit(fun () -> mode := RDFT),
Chris@42 74 " generate a real DFT codelet";
Chris@42 75
Chris@42 76 "-hdft",
Chris@42 77 Arg.Unit(fun () -> mode := HDFT),
Chris@42 78 " generate a Hermitian DFT codelet";
Chris@42 79
Chris@42 80 "-dht",
Chris@42 81 Arg.Unit(fun () -> mode := DHT),
Chris@42 82 " generate a DHT codelet";
Chris@42 83
Chris@42 84 "-redft00",
Chris@42 85 Arg.Unit(fun () -> mode := REDFT00),
Chris@42 86 " generate a DCT-I codelet";
Chris@42 87
Chris@42 88 "-redft10",
Chris@42 89 Arg.Unit(fun () -> mode := REDFT10),
Chris@42 90 " generate a DCT-II codelet";
Chris@42 91
Chris@42 92 "-redft01",
Chris@42 93 Arg.Unit(fun () -> mode := REDFT01),
Chris@42 94 " generate a DCT-III codelet";
Chris@42 95
Chris@42 96 "-redft11",
Chris@42 97 Arg.Unit(fun () -> mode := REDFT11),
Chris@42 98 " generate a DCT-IV codelet";
Chris@42 99
Chris@42 100 "-rodft00",
Chris@42 101 Arg.Unit(fun () -> mode := RODFT00),
Chris@42 102 " generate a DST-I codelet";
Chris@42 103
Chris@42 104 "-rodft10",
Chris@42 105 Arg.Unit(fun () -> mode := RODFT10),
Chris@42 106 " generate a DST-II codelet";
Chris@42 107
Chris@42 108 "-rodft01",
Chris@42 109 Arg.Unit(fun () -> mode := RODFT01),
Chris@42 110 " generate a DST-III codelet";
Chris@42 111
Chris@42 112 "-rodft11",
Chris@42 113 Arg.Unit(fun () -> mode := RODFT11),
Chris@42 114 " generate a DST-IV codelet";
Chris@42 115
Chris@42 116 "-normalization",
Chris@42 117 Arg.String(fun x -> let ix = int_of_string x in normsqr := ix * ix),
Chris@42 118 " normalization integer to divide by";
Chris@42 119
Chris@42 120 "-normsqr",
Chris@42 121 Arg.String(fun x -> normsqr := int_of_string x),
Chris@42 122 " integer square of normalization to divide by";
Chris@42 123
Chris@42 124 "-unitary",
Chris@42 125 Arg.Unit(fun () -> unitary := true),
Chris@42 126 " unitary normalization (up overall scale factor)";
Chris@42 127
Chris@42 128 "-noloop",
Chris@42 129 Arg.Unit(fun () -> noloop := true),
Chris@42 130 " no vector loop";
Chris@42 131 ]
Chris@42 132
Chris@42 133 let sqrt_half = Complex.inverse_int_sqrt 2
Chris@42 134 let sqrt_two = Complex.int_sqrt 2
Chris@42 135
Chris@42 136 let rescale sc s1 s2 input i =
Chris@42 137 if ((i == s1 || i == s2) && !unitary) then
Chris@42 138 Complex.times (input i) sc
Chris@42 139 else
Chris@42 140 input i
Chris@42 141
Chris@42 142 let generate n mode =
Chris@42 143 let iarray = "I"
Chris@42 144 and oarray = "O"
Chris@42 145 and istride = "is"
Chris@42 146 and ostride = "os"
Chris@42 147 and i = "i"
Chris@42 148 and v = "v"
Chris@42 149 in
Chris@42 150
Chris@42 151 let sign = !Genutil.sign
Chris@42 152 and name = !Magic.codelet_name in
Chris@42 153
Chris@42 154 let vistride = either_stride (!uistride) (C.SVar istride)
Chris@42 155 and vostride = either_stride (!uostride) (C.SVar ostride)
Chris@42 156 in
Chris@42 157
Chris@42 158 let sovs = stride_to_string "ovs" !uovstride in
Chris@42 159 let sivs = stride_to_string "ivs" !uivstride in
Chris@42 160
Chris@42 161 let (transform, load_input, store_output, si1,si2,so1,so2) = match mode with
Chris@42 162 | RDFT -> Trig.rdft sign, load_array_r, store_array_hc, -1,-1,-1,-1
Chris@42 163 | HDFT -> Trig.hdft sign, load_array_c, store_array_r, -1,-1,-1,-1 (* TODO *)
Chris@42 164 | DHT -> Trig.dht 1, load_array_r, store_array_r, -1,-1,-1,-1
Chris@42 165 | REDFT00 -> Trig.dctI, load_array_r, store_array_r, 0,n-1,0,n-1
Chris@42 166 | REDFT10 -> Trig.dctII, load_array_r, store_array_r, -1,-1,0,-1
Chris@42 167 | REDFT01 -> Trig.dctIII, load_array_r, store_array_r, 0,-1,-1,-1
Chris@42 168 | REDFT11 -> Trig.dctIV, load_array_r, store_array_r, -1,-1,-1,-1
Chris@42 169 | RODFT00 -> Trig.dstI, load_array_r, store_array_r, -1,-1,-1,-1
Chris@42 170 | RODFT10 -> Trig.dstII, load_array_r, store_array_r, -1,-1,n-1,-1
Chris@42 171 | RODFT01 -> Trig.dstIII, load_array_r, store_array_r, n-1,-1,-1,-1
Chris@42 172 | RODFT11 -> Trig.dstIV, load_array_r, store_array_r, -1,-1,-1,-1
Chris@42 173 | _ -> failwith "must specify transform kind"
Chris@42 174 in
Chris@42 175
Chris@42 176 let locations = unique_array_c n in
Chris@42 177 let input = locative_array_c n
Chris@42 178 (C.array_subscript iarray vistride)
Chris@42 179 (C.array_subscript "BUG" vistride)
Chris@42 180 locations sivs in
Chris@42 181 let output = rescale sqrt_half so1 so2
Chris@42 182 ((Complex.times (Complex.inverse_int_sqrt !normsqr))
Chris@42 183 @@ (transform n (rescale sqrt_two si1 si2 (load_array_c n input)))) in
Chris@42 184 let oloc =
Chris@42 185 locative_array_c n
Chris@42 186 (C.array_subscript oarray vostride)
Chris@42 187 (C.array_subscript "BUG" vostride)
Chris@42 188 locations sovs in
Chris@42 189 let odag = store_output n oloc output in
Chris@42 190 let annot = standard_optimizer odag in
Chris@42 191
Chris@42 192 let body = if !noloop then Block([], [Asch annot]) else Block (
Chris@42 193 [Decl ("INT", i)],
Chris@42 194 [For (Expr_assign (CVar i, CVar v),
Chris@42 195 Binop (" > ", CVar i, Integer 0),
Chris@42 196 list_to_comma
Chris@42 197 [Expr_assign (CVar i, CPlus [CVar i; CUminus (Integer 1)]);
Chris@42 198 Expr_assign (CVar iarray, CPlus [CVar iarray; CVar sivs]);
Chris@42 199 Expr_assign (CVar oarray, CPlus [CVar oarray; CVar sovs]);
Chris@42 200 make_volatile_stride (2*n) (CVar istride);
Chris@42 201 make_volatile_stride (2*n) (CVar ostride)
Chris@42 202 ],
Chris@42 203 Asch annot)
Chris@42 204 ])
Chris@42 205 in
Chris@42 206
Chris@42 207 let tree =
Chris@42 208 Fcn ((if !Magic.standalone then "void" else "static void"), name,
Chris@42 209 ([Decl (C.constrealtypep, iarray);
Chris@42 210 Decl (C.realtypep, oarray)]
Chris@42 211 @ (if stride_fixed !uistride then []
Chris@42 212 else [Decl (C.stridetype, istride)])
Chris@42 213 @ (if stride_fixed !uostride then []
Chris@42 214 else [Decl (C.stridetype, ostride)])
Chris@42 215 @ (if !noloop then [] else
Chris@42 216 [Decl ("INT", v)]
Chris@42 217 @ (if stride_fixed !uivstride then []
Chris@42 218 else [Decl ("INT", "ivs")])
Chris@42 219 @ (if stride_fixed !uovstride then []
Chris@42 220 else [Decl ("INT", "ovs")]))),
Chris@42 221 finalize_fcn body)
Chris@42 222
Chris@42 223 in let desc =
Chris@42 224 Printf.sprintf
Chris@42 225 "static const kr2r_desc desc = { %d, \"%s\", %s, &GENUS, %s };\n\n"
Chris@42 226 n name (flops_of tree)
Chris@42 227 (match mode with
Chris@42 228 | RDFT -> "RDFT00"
Chris@42 229 | HDFT -> "HDFT00"
Chris@42 230 | DHT -> "DHT"
Chris@42 231 | REDFT00 -> "REDFT00"
Chris@42 232 | REDFT10 -> "REDFT10"
Chris@42 233 | REDFT01 -> "REDFT01"
Chris@42 234 | REDFT11 -> "REDFT11"
Chris@42 235 | RODFT00 -> "RODFT00"
Chris@42 236 | RODFT10 -> "RODFT10"
Chris@42 237 | RODFT01 -> "RODFT01"
Chris@42 238 | RODFT11 -> "RODFT11"
Chris@42 239 | _ -> failwith "must specify a transform kind")
Chris@42 240
Chris@42 241 and init =
Chris@42 242 (declare_register_fcn name) ^
Chris@42 243 "{" ^
Chris@42 244 " X(kr2r_register)(p, " ^ name ^ ", &desc);\n" ^
Chris@42 245 "}\n"
Chris@42 246
Chris@42 247 in
Chris@42 248 (unparse tree) ^ "\n" ^ (if !Magic.standalone then "" else desc ^ init)
Chris@42 249
Chris@42 250
Chris@42 251 let main () =
Chris@42 252 begin
Chris@42 253 parse speclist usage;
Chris@42 254 print_string (generate (check_size ()) !mode);
Chris@42 255 end
Chris@42 256
Chris@42 257 let _ = main()