annotate src/fftw-3.3.5/genfft/gen_mdct.ml @ 83:ae30d91d2ffe

Replace these with versions built using an older toolset (so as to avoid ABI compatibilities when linking on Ubuntu 14.04 for packaging purposes)
author Chris Cannam
date Fri, 07 Feb 2020 11:51:13 +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 let normalization = ref 1
Chris@42 36
Chris@42 37 type mode =
Chris@42 38 | MDCT
Chris@42 39 | MDCT_MP3
Chris@42 40 | MDCT_VORBIS
Chris@42 41 | MDCT_WINDOW
Chris@42 42 | MDCT_WINDOW_SYM
Chris@42 43 | IMDCT
Chris@42 44 | IMDCT_MP3
Chris@42 45 | IMDCT_VORBIS
Chris@42 46 | IMDCT_WINDOW
Chris@42 47 | IMDCT_WINDOW_SYM
Chris@42 48 | NONE
Chris@42 49
Chris@42 50 let mode = ref NONE
Chris@42 51
Chris@42 52 let speclist = [
Chris@42 53 "-with-istride",
Chris@42 54 Arg.String(fun x -> uistride := arg_to_stride x),
Chris@42 55 " specialize for given input stride";
Chris@42 56
Chris@42 57 "-with-ostride",
Chris@42 58 Arg.String(fun x -> uostride := arg_to_stride x),
Chris@42 59 " specialize for given output stride";
Chris@42 60
Chris@42 61 "-with-ivstride",
Chris@42 62 Arg.String(fun x -> uivstride := arg_to_stride x),
Chris@42 63 " specialize for given input vector stride";
Chris@42 64
Chris@42 65 "-with-ovstride",
Chris@42 66 Arg.String(fun x -> uovstride := arg_to_stride x),
Chris@42 67 " specialize for given output vector stride";
Chris@42 68
Chris@42 69 "-normalization",
Chris@42 70 Arg.String(fun x -> normalization := int_of_string x),
Chris@42 71 " normalization integer to divide by";
Chris@42 72
Chris@42 73 "-mdct",
Chris@42 74 Arg.Unit(fun () -> mode := MDCT),
Chris@42 75 " generate an MDCT codelet";
Chris@42 76
Chris@42 77 "-mdct-mp3",
Chris@42 78 Arg.Unit(fun () -> mode := MDCT_MP3),
Chris@42 79 " generate an MDCT codelet with MP3 windowing";
Chris@42 80
Chris@42 81 "-mdct-window",
Chris@42 82 Arg.Unit(fun () -> mode := MDCT_WINDOW),
Chris@42 83 " generate an MDCT codelet with window array";
Chris@42 84
Chris@42 85 "-mdct-window-sym",
Chris@42 86 Arg.Unit(fun () -> mode := MDCT_WINDOW_SYM),
Chris@42 87 " generate an MDCT codelet with symmetric window array";
Chris@42 88
Chris@42 89 "-imdct",
Chris@42 90 Arg.Unit(fun () -> mode := IMDCT),
Chris@42 91 " generate an IMDCT codelet";
Chris@42 92
Chris@42 93 "-imdct-mp3",
Chris@42 94 Arg.Unit(fun () -> mode := IMDCT_MP3),
Chris@42 95 " generate an IMDCT codelet with MP3 windowing";
Chris@42 96
Chris@42 97 "-imdct-window",
Chris@42 98 Arg.Unit(fun () -> mode := IMDCT_WINDOW),
Chris@42 99 " generate an IMDCT codelet with window array";
Chris@42 100
Chris@42 101 "-imdct-window-sym",
Chris@42 102 Arg.Unit(fun () -> mode := IMDCT_WINDOW_SYM),
Chris@42 103 " generate an IMDCT codelet with symmetric window array";
Chris@42 104 ]
Chris@42 105
Chris@42 106 let unity_window n i = Complex.one
Chris@42 107
Chris@42 108 (* MP3 window(k) = sin(pi/(2n) * (k + 1/2)) *)
Chris@42 109 let mp3_window n k =
Chris@42 110 Complex.imag (Complex.exp (8 * n) (2*k + 1))
Chris@42 111
Chris@42 112 (* Vorbis window(k) = sin(pi/2 * (mp3_window(k))^2)
Chris@42 113 ... this is transcendental, though, so we can't do it with our
Chris@42 114 current Complex.exp function *)
Chris@42 115
Chris@42 116 let window_array n w =
Chris@42 117 array n (fun i ->
Chris@42 118 let stride = C.SInteger 1
Chris@42 119 and klass = Unique.make () in
Chris@42 120 let refr = C.array_subscript w stride i in
Chris@42 121 let kr = Variable.make_constant klass refr in
Chris@42 122 load_r (kr, kr))
Chris@42 123
Chris@42 124 let load_window w n i = w i
Chris@42 125 let load_window_sym w n i = w (if (i < n) then i else (2*n - 1 - i))
Chris@42 126
Chris@42 127 (* fixme: use same locations for input and output so that it works in-place? *)
Chris@42 128
Chris@42 129 (* Note: only correct for even n! *)
Chris@42 130 let load_array_mdct window n rarr iarr locations =
Chris@42 131 let twon = 2 * n in
Chris@42 132 let arr = load_array_c twon
Chris@42 133 (locative_array_c twon rarr iarr locations "BUG") in
Chris@42 134 let arrw = fun i -> Complex.times (window n i) (arr i) in
Chris@42 135 array n
Chris@42 136 ((Complex.times Complex.half) @@
Chris@42 137 (fun i ->
Chris@42 138 if (i < n/2) then
Chris@42 139 Complex.uminus (Complex.plus [arrw (i + n + n/2);
Chris@42 140 arrw (n + n/2 - 1 - i)])
Chris@42 141 else
Chris@42 142 Complex.plus [arrw (i - n/2);
Chris@42 143 Complex.uminus (arrw (n + n/2 - 1 - i))]))
Chris@42 144
Chris@42 145 let store_array_mdct window n rarr iarr locations arr =
Chris@42 146 store_array_r n (locative_array_c n rarr iarr locations "BUG") arr
Chris@42 147
Chris@42 148 let load_array_imdct window n rarr iarr locations =
Chris@42 149 load_array_c n (locative_array_c n rarr iarr locations "BUG")
Chris@42 150
Chris@42 151 let store_array_imdct window n rarr iarr locations arr =
Chris@42 152 let n2 = n/2 in
Chris@42 153 let threen2 = 3*n2 in
Chris@42 154 let arr2 = fun i ->
Chris@42 155 if (i < n2) then
Chris@42 156 arr (i + n2)
Chris@42 157 else if (i < threen2) then
Chris@42 158 Complex.uminus (arr (threen2 - 1 - i))
Chris@42 159 else
Chris@42 160 Complex.uminus (arr (i - threen2))
Chris@42 161 in
Chris@42 162 let arr2w = fun i -> Complex.times (window n i) (arr2 i) in
Chris@42 163 let twon = 2 * n in
Chris@42 164 store_array_r twon (locative_array_c twon rarr iarr locations "BUG") arr2w
Chris@42 165
Chris@42 166 let window_param = function
Chris@42 167 MDCT_WINDOW -> true
Chris@42 168 | MDCT_WINDOW_SYM -> true
Chris@42 169 | IMDCT_WINDOW -> true
Chris@42 170 | IMDCT_WINDOW_SYM -> true
Chris@42 171 | _ -> false
Chris@42 172
Chris@42 173 let generate n mode =
Chris@42 174 let iarray = "I"
Chris@42 175 and oarray = "O"
Chris@42 176 and istride = "istride"
Chris@42 177 and ostride = "ostride"
Chris@42 178 and window = "W"
Chris@42 179 and name = !Magic.codelet_name in
Chris@42 180
Chris@42 181 let vistride = either_stride (!uistride) (C.SVar istride)
Chris@42 182 and vostride = either_stride (!uostride) (C.SVar ostride)
Chris@42 183 in
Chris@42 184
Chris@42 185 let sivs = stride_to_string "ovs" !uovstride in
Chris@42 186 let sovs = stride_to_string "ivs" !uivstride in
Chris@42 187
Chris@42 188 let (transform, load_input, store_output) = match mode with
Chris@42 189 | MDCT -> Trig.dctIV, load_array_mdct unity_window,
Chris@42 190 store_array_mdct unity_window
Chris@42 191 | MDCT_MP3 -> Trig.dctIV, load_array_mdct mp3_window,
Chris@42 192 store_array_mdct unity_window
Chris@42 193 | MDCT_WINDOW -> Trig.dctIV, load_array_mdct
Chris@42 194 (load_window (window_array (2 * n) window)),
Chris@42 195 store_array_mdct unity_window
Chris@42 196 | MDCT_WINDOW_SYM -> Trig.dctIV, load_array_mdct
Chris@42 197 (load_window_sym (window_array n window)),
Chris@42 198 store_array_mdct unity_window
Chris@42 199 | IMDCT -> Trig.dctIV, load_array_imdct unity_window,
Chris@42 200 store_array_imdct unity_window
Chris@42 201 | IMDCT_MP3 -> Trig.dctIV, load_array_imdct unity_window,
Chris@42 202 store_array_imdct mp3_window
Chris@42 203 | IMDCT_WINDOW -> Trig.dctIV, load_array_imdct unity_window,
Chris@42 204 store_array_imdct (load_window (window_array (2 * n) window))
Chris@42 205 | IMDCT_WINDOW_SYM -> Trig.dctIV, load_array_imdct unity_window,
Chris@42 206 store_array_imdct (load_window_sym (window_array n window))
Chris@42 207 | _ -> failwith "must specify transform kind"
Chris@42 208 in
Chris@42 209
Chris@42 210 let locations = unique_array_c (2*n) in
Chris@42 211 let input =
Chris@42 212 load_input n
Chris@42 213 (C.array_subscript iarray vistride)
Chris@42 214 (C.array_subscript "BUG" vistride)
Chris@42 215 locations
Chris@42 216 in
Chris@42 217 let output = (Complex.times (Complex.inverse_int !normalization))
Chris@42 218 @@ (transform n input) in
Chris@42 219 let odag =
Chris@42 220 store_output n
Chris@42 221 (C.array_subscript oarray vostride)
Chris@42 222 (C.array_subscript "BUG" vostride)
Chris@42 223 locations
Chris@42 224 output
Chris@42 225 in
Chris@42 226 let annot = standard_optimizer odag in
Chris@42 227
Chris@42 228 let tree =
Chris@42 229 Fcn ("void", name,
Chris@42 230 ([Decl (C.constrealtypep, iarray);
Chris@42 231 Decl (C.realtypep, oarray)]
Chris@42 232 @ (if stride_fixed !uistride then []
Chris@42 233 else [Decl (C.stridetype, istride)])
Chris@42 234 @ (if stride_fixed !uostride then []
Chris@42 235 else [Decl (C.stridetype, ostride)])
Chris@42 236 @ (choose_simd []
Chris@42 237 (if stride_fixed !uivstride then [] else
Chris@42 238 [Decl ("int", sivs)]))
Chris@42 239 @ (choose_simd []
Chris@42 240 (if stride_fixed !uovstride then [] else
Chris@42 241 [Decl ("int", sovs)]))
Chris@42 242 @ (if (not (window_param mode)) then []
Chris@42 243 else [Decl (C.constrealtypep, window)])
Chris@42 244 ),
Chris@42 245 finalize_fcn (Asch annot))
Chris@42 246
Chris@42 247 in
Chris@42 248 (unparse tree) ^ "\n"
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()