cannam@127: (*
cannam@127:  * Copyright (c) 1997-1999 Massachusetts Institute of Technology
cannam@127:  * Copyright (c) 2003, 2007-14 Matteo Frigo
cannam@127:  * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
cannam@127:  *
cannam@127:  * This program is free software; you can redistribute it and/or modify
cannam@127:  * it under the terms of the GNU General Public License as published by
cannam@127:  * the Free Software Foundation; either version 2 of the License, or
cannam@127:  * (at your option) any later version.
cannam@127:  *
cannam@127:  * This program is distributed in the hope that it will be useful,
cannam@127:  * but WITHOUT ANY WARRANTY; without even the implied warranty of
cannam@127:  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
cannam@127:  * GNU General Public License for more details.
cannam@127:  *
cannam@127:  * You should have received a copy of the GNU General Public License
cannam@127:  * along with this program; if not, write to the Free Software
cannam@127:  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
cannam@127:  *
cannam@127:  *)
cannam@127: 
cannam@127: (* generation of trigonometric transforms *)
cannam@127: 
cannam@127: open Util
cannam@127: open Genutil
cannam@127: open C
cannam@127: 
cannam@127: 
cannam@127: let usage = "Usage: " ^ Sys.argv.(0) ^ " -n <number>"
cannam@127: 
cannam@127: let uistride = ref Stride_variable
cannam@127: let uostride = ref Stride_variable
cannam@127: let uivstride = ref Stride_variable
cannam@127: let uovstride = ref Stride_variable
cannam@127: let normalization = ref 1
cannam@127: 
cannam@127: type mode =
cannam@127:   | MDCT
cannam@127:   | MDCT_MP3
cannam@127:   | MDCT_VORBIS
cannam@127:   | MDCT_WINDOW
cannam@127:   | MDCT_WINDOW_SYM
cannam@127:   | IMDCT
cannam@127:   | IMDCT_MP3
cannam@127:   | IMDCT_VORBIS
cannam@127:   | IMDCT_WINDOW
cannam@127:   | IMDCT_WINDOW_SYM
cannam@127:   | NONE
cannam@127: 
cannam@127: let mode = ref NONE
cannam@127: 
cannam@127: let speclist = [
cannam@127:   "-with-istride",
cannam@127:   Arg.String(fun x -> uistride := arg_to_stride x),
cannam@127:   " specialize for given input stride";
cannam@127: 
cannam@127:   "-with-ostride",
cannam@127:   Arg.String(fun x -> uostride := arg_to_stride x),
cannam@127:   " specialize for given output stride";
cannam@127: 
cannam@127:   "-with-ivstride",
cannam@127:   Arg.String(fun x -> uivstride := arg_to_stride x),
cannam@127:   " specialize for given input vector stride";
cannam@127: 
cannam@127:   "-with-ovstride",
cannam@127:   Arg.String(fun x -> uovstride := arg_to_stride x),
cannam@127:   " specialize for given output vector stride";
cannam@127: 
cannam@127:   "-normalization",
cannam@127:   Arg.String(fun x -> normalization := int_of_string x),
cannam@127:   " normalization integer to divide by";
cannam@127: 
cannam@127:   "-mdct",
cannam@127:   Arg.Unit(fun () -> mode := MDCT),
cannam@127:   " generate an MDCT codelet";
cannam@127: 
cannam@127:   "-mdct-mp3",
cannam@127:   Arg.Unit(fun () -> mode := MDCT_MP3),
cannam@127:   " generate an MDCT codelet with MP3 windowing";
cannam@127: 
cannam@127:   "-mdct-window",
cannam@127:   Arg.Unit(fun () -> mode := MDCT_WINDOW),
cannam@127:   " generate an MDCT codelet with window array";
cannam@127: 
cannam@127:   "-mdct-window-sym",
cannam@127:   Arg.Unit(fun () -> mode := MDCT_WINDOW_SYM),
cannam@127:   " generate an MDCT codelet with symmetric window array";
cannam@127: 
cannam@127:   "-imdct",
cannam@127:   Arg.Unit(fun () -> mode := IMDCT),
cannam@127:   " generate an IMDCT codelet";
cannam@127: 
cannam@127:   "-imdct-mp3",
cannam@127:   Arg.Unit(fun () -> mode := IMDCT_MP3),
cannam@127:   " generate an IMDCT codelet with MP3 windowing";
cannam@127: 
cannam@127:   "-imdct-window",
cannam@127:   Arg.Unit(fun () -> mode := IMDCT_WINDOW),
cannam@127:   " generate an IMDCT codelet with window array";
cannam@127: 
cannam@127:   "-imdct-window-sym",
cannam@127:   Arg.Unit(fun () -> mode := IMDCT_WINDOW_SYM),
cannam@127:   " generate an IMDCT codelet with symmetric window array";
cannam@127: ]
cannam@127: 
cannam@127: let unity_window n i = Complex.one
cannam@127: 
cannam@127: (* MP3 window(k) = sin(pi/(2n) * (k + 1/2)) *)
cannam@127: let mp3_window n k = 
cannam@127:   Complex.imag (Complex.exp (8 * n) (2*k + 1))
cannam@127: 
cannam@127: (* Vorbis window(k) = sin(pi/2 * (mp3_window(k))^2)
cannam@127:     ... this is transcendental, though, so we can't do it with our
cannam@127:         current Complex.exp function *)
cannam@127: 
cannam@127: let window_array n w =
cannam@127:     array n (fun i ->
cannam@127:       let stride = C.SInteger 1
cannam@127:       and klass = Unique.make () in
cannam@127:       let refr = C.array_subscript w stride i in
cannam@127:       let kr = Variable.make_constant klass refr in
cannam@127:       load_r (kr, kr))
cannam@127: 
cannam@127: let load_window w n i = w i
cannam@127: let load_window_sym w n i = w (if (i < n) then i else (2*n - 1 - i))
cannam@127: 
cannam@127: (* fixme: use same locations for input and output so that it works in-place? *)
cannam@127: 
cannam@127: (* Note: only correct for even n! *)
cannam@127: let load_array_mdct window n rarr iarr locations =
cannam@127:   let twon = 2 * n in
cannam@127:   let arr = load_array_c twon 
cannam@127:       (locative_array_c twon rarr iarr locations "BUG") in
cannam@127:   let arrw = fun i -> Complex.times (window n i) (arr i) in
cannam@127:   array n
cannam@127:     ((Complex.times Complex.half) @@
cannam@127:      (fun i ->
cannam@127:        if (i < n/2) then
cannam@127: 	 Complex.uminus (Complex.plus [arrw (i + n + n/2); 
cannam@127: 				       arrw (n + n/2 - 1 - i)])
cannam@127:        else
cannam@127: 	 Complex.plus [arrw (i - n/2); 
cannam@127: 		       Complex.uminus (arrw (n + n/2 - 1 - i))]))
cannam@127: 
cannam@127: let store_array_mdct window n rarr iarr locations arr =
cannam@127:   store_array_r n (locative_array_c n rarr iarr locations "BUG") arr
cannam@127: 
cannam@127: let load_array_imdct window n rarr iarr locations =
cannam@127:   load_array_c n (locative_array_c n rarr iarr locations "BUG")
cannam@127: 
cannam@127: let store_array_imdct window n rarr iarr locations arr =
cannam@127:   let n2 = n/2 in
cannam@127:   let threen2 = 3*n2 in
cannam@127:   let arr2 = fun i ->
cannam@127:     if (i < n2) then
cannam@127:       arr (i + n2)
cannam@127:     else if (i < threen2) then
cannam@127:       Complex.uminus (arr (threen2 - 1 - i))
cannam@127:     else
cannam@127:       Complex.uminus (arr (i - threen2))
cannam@127:   in
cannam@127:   let arr2w = fun i -> Complex.times (window n i) (arr2 i) in
cannam@127:   let twon = 2 * n in
cannam@127:   store_array_r twon (locative_array_c twon rarr iarr locations "BUG") arr2w
cannam@127: 
cannam@127: let window_param = function
cannam@127:     MDCT_WINDOW -> true
cannam@127:   | MDCT_WINDOW_SYM -> true
cannam@127:   | IMDCT_WINDOW -> true
cannam@127:   | IMDCT_WINDOW_SYM -> true
cannam@127:   | _ -> false
cannam@127: 
cannam@127: let generate n mode =
cannam@127:   let iarray = "I"
cannam@127:   and oarray = "O"
cannam@127:   and istride = "istride"
cannam@127:   and ostride = "ostride" 
cannam@127:   and window = "W" 
cannam@127:   and name = !Magic.codelet_name in
cannam@127: 
cannam@127:   let vistride = either_stride (!uistride) (C.SVar istride)
cannam@127:   and vostride = either_stride (!uostride) (C.SVar ostride)
cannam@127:   in
cannam@127: 
cannam@127:   let sivs = stride_to_string "ovs" !uovstride in
cannam@127:   let sovs = stride_to_string "ivs" !uivstride in
cannam@127: 
cannam@127:   let (transform, load_input, store_output) = match mode with
cannam@127:   | MDCT -> Trig.dctIV, load_array_mdct unity_window,
cannam@127:       store_array_mdct unity_window
cannam@127:   | MDCT_MP3 -> Trig.dctIV, load_array_mdct mp3_window,
cannam@127:       store_array_mdct unity_window
cannam@127:   | MDCT_WINDOW -> Trig.dctIV, load_array_mdct
cannam@127: 	(load_window (window_array (2 * n) window)),
cannam@127:       store_array_mdct unity_window
cannam@127:   | MDCT_WINDOW_SYM -> Trig.dctIV, load_array_mdct
cannam@127: 	(load_window_sym (window_array n window)),
cannam@127:       store_array_mdct unity_window
cannam@127:   | IMDCT -> Trig.dctIV, load_array_imdct unity_window,
cannam@127:       store_array_imdct unity_window
cannam@127:   | IMDCT_MP3 -> Trig.dctIV, load_array_imdct unity_window,
cannam@127:       store_array_imdct mp3_window
cannam@127:   | IMDCT_WINDOW -> Trig.dctIV, load_array_imdct unity_window,
cannam@127:       store_array_imdct (load_window (window_array (2 * n) window))
cannam@127:   | IMDCT_WINDOW_SYM -> Trig.dctIV, load_array_imdct unity_window,
cannam@127:       store_array_imdct (load_window_sym (window_array n window))
cannam@127:   | _ -> failwith "must specify transform kind"
cannam@127:   in
cannam@127:     
cannam@127:   let locations = unique_array_c (2*n) in
cannam@127:   let input = 
cannam@127:     load_input n
cannam@127:       (C.array_subscript iarray vistride)
cannam@127:       (C.array_subscript "BUG" vistride)
cannam@127:       locations
cannam@127:   in
cannam@127:   let output = (Complex.times (Complex.inverse_int !normalization)) 
cannam@127:     @@ (transform n input) in
cannam@127:   let odag =
cannam@127:     store_output n
cannam@127:       (C.array_subscript oarray vostride)
cannam@127:       (C.array_subscript "BUG" vostride)
cannam@127:       locations 
cannam@127:       output
cannam@127:   in
cannam@127:   let annot = standard_optimizer odag in
cannam@127: 
cannam@127:   let tree =
cannam@127:     Fcn ("void", name,
cannam@127: 	 ([Decl (C.constrealtypep, iarray);
cannam@127: 	   Decl (C.realtypep, oarray)]
cannam@127: 	  @ (if stride_fixed !uistride then [] 
cannam@127:                else [Decl (C.stridetype, istride)])
cannam@127: 	  @ (if stride_fixed !uostride then [] 
cannam@127: 	       else [Decl (C.stridetype, ostride)])
cannam@127: 	  @ (choose_simd []
cannam@127: 	       (if stride_fixed !uivstride then [] else 
cannam@127: 	       [Decl ("int", sivs)]))
cannam@127: 	  @ (choose_simd []
cannam@127: 	       (if stride_fixed !uovstride then [] else 
cannam@127: 	       [Decl ("int", sovs)]))
cannam@127: 	  @ (if (not (window_param mode)) then [] 
cannam@127: 	       else [Decl (C.constrealtypep, window)])
cannam@127: 	 ),
cannam@127: 	 finalize_fcn (Asch annot))
cannam@127: 
cannam@127:   in
cannam@127:   (unparse tree) ^ "\n"
cannam@127: 
cannam@127: 
cannam@127: let main () =
cannam@127:   begin
cannam@127:     parse speclist usage;
cannam@127:     print_string (generate (check_size ()) !mode);
cannam@127:   end
cannam@127: 
cannam@127: let _ = main()