Chris@10: (*
Chris@10:  * Copyright (c) 1997-1999 Massachusetts Institute of Technology
Chris@10:  * Copyright (c) 2003, 2007-11 Matteo Frigo
Chris@10:  * Copyright (c) 2003, 2007-11 Massachusetts Institute of Technology
Chris@10:  *
Chris@10:  * This program is free software; you can redistribute it and/or modify
Chris@10:  * it under the terms of the GNU General Public License as published by
Chris@10:  * the Free Software Foundation; either version 2 of the License, or
Chris@10:  * (at your option) any later version.
Chris@10:  *
Chris@10:  * This program is distributed in the hope that it will be useful,
Chris@10:  * but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@10:  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Chris@10:  * GNU General Public License for more details.
Chris@10:  *
Chris@10:  * You should have received a copy of the GNU General Public License
Chris@10:  * along with this program; if not, write to the Free Software
Chris@10:  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
Chris@10:  *
Chris@10:  *)
Chris@10: 
Chris@10: (* policies for loading/computing twiddle factors *)
Chris@10: open Complex
Chris@10: open Util
Chris@10: 
Chris@10: type twop = TW_FULL | TW_CEXP | TW_NEXT
Chris@10: 
Chris@10: let optostring = function
Chris@10:   | TW_CEXP -> "TW_CEXP"
Chris@10:   | TW_NEXT -> "TW_NEXT"
Chris@10:   | TW_FULL -> "TW_FULL"
Chris@10: 
Chris@10: type twinstr = (twop * int * int)
Chris@10: 
Chris@10: let rec unroll_twfull l = match l with
Chris@10: | [] -> []
Chris@10: | (TW_FULL, v, n) :: b ->
Chris@10:     (forall [] cons 1 n (fun i -> (TW_CEXP, v, i)))
Chris@10:     @ unroll_twfull b
Chris@10: | a :: b -> a :: unroll_twfull b
Chris@10: 
Chris@10: let twinstr_to_c_string l =
Chris@10:   let one (op, a, b) = Printf.sprintf "{ %s, %d, %d }" (optostring op) a b
Chris@10:   in let rec loop first = function
Chris@10:     | [] -> ""
Chris@10:     | a :: b ->  (if first then "\n" else ",\n") ^ (one a) ^ (loop false b)
Chris@10:   in "{" ^ (loop true l) ^ "}"
Chris@10: 
Chris@10: let twinstr_to_simd_string vl l =
Chris@10:   let one sep = function
Chris@10:     | (TW_NEXT, 1, 0) -> sep ^ "{TW_NEXT, " ^ vl ^ ", 0}"
Chris@10:     | (TW_NEXT, _, _) -> failwith "twinstr_to_simd_string"
Chris@10:     | (TW_CEXP, v, b) -> sep ^ (Printf.sprintf "VTW(%d,%d)" v b)
Chris@10:     | _ -> failwith "twinstr_to_simd_string"
Chris@10:   in let rec loop first = function
Chris@10:     | [] -> ""
Chris@10:     | a :: b ->  (one (if first then "\n" else ",\n") a) ^ (loop false b)
Chris@10:   in "{" ^ (loop true (unroll_twfull l)) ^ "}"
Chris@10:   
Chris@10: let rec pow m n =
Chris@10:   if (n = 0) then 1
Chris@10:   else m * pow m (n - 1)
Chris@10: 
Chris@10: let rec is_pow m n =
Chris@10:   n = 1 || ((n mod m) = 0 && is_pow m (n / m))
Chris@10: 
Chris@10: let rec log m n = if n = 1 then 0 else 1 + log m (n / m)
Chris@10: 
Chris@10: let rec largest_power_smaller_than m i =
Chris@10:   if (is_pow m i) then i
Chris@10:   else largest_power_smaller_than m (i - 1)
Chris@10: 
Chris@10: let rec smallest_power_larger_than m i =
Chris@10:   if (is_pow m i) then i
Chris@10:   else smallest_power_larger_than m (i + 1)
Chris@10: 
Chris@10: let rec_array n f =
Chris@10:   let g = ref (fun i -> Complex.zero) in
Chris@10:   let a = Array.init n (fun i -> lazy (!g i)) in
Chris@10:   let h i = f (fun i -> Lazy.force a.(i)) i in
Chris@10:   begin
Chris@10:     g := h;
Chris@10:     h
Chris@10:   end
Chris@10: 
Chris@10:  
Chris@10: let ctimes use_complex_arith a b =
Chris@10:   if use_complex_arith then
Chris@10:     Complex.ctimes a b
Chris@10:   else
Chris@10:     Complex.times a b
Chris@10: 
Chris@10: let ctimesj use_complex_arith a b =
Chris@10:   if use_complex_arith then
Chris@10:     Complex.ctimesj a b
Chris@10:   else
Chris@10:     Complex.times (Complex.conj a) b
Chris@10: 
Chris@10: let make_bytwiddle sign use_complex_arith g f i =
Chris@10:   if i = 0 then 
Chris@10:     f i
Chris@10:   else if sign = 1 then 
Chris@10:     ctimes use_complex_arith (g i) (f i)
Chris@10:   else
Chris@10:     ctimesj use_complex_arith (g i) (f i)
Chris@10: 
Chris@10: (* various policies for computing/loading twiddle factors *)
Chris@10: 
Chris@10: let twiddle_policy_load_all v use_complex_arith =
Chris@10:   let bytwiddle n sign w f =
Chris@10:     make_bytwiddle sign use_complex_arith (fun i -> w (i - 1)) f
Chris@10:   and twidlen n = 2 * (n - 1)
Chris@10:   and twdesc r = [(TW_FULL, v, r);(TW_NEXT, 1, 0)]
Chris@10:   in bytwiddle, twidlen, twdesc
Chris@10: 
Chris@10: (*
Chris@10:  * if i is a power of two, then load w (log i)
Chris@10:  * else let x = largest power of 2 less than i in
Chris@10:  *      let y = i - x in
Chris@10:  *      compute w^{x+y} = w^x * w^y
Chris@10:  *)
Chris@10: let twiddle_policy_log2 v use_complex_arith =
Chris@10:   let bytwiddle n sign w f =
Chris@10:     let g = rec_array n (fun self i ->
Chris@10:       if i = 0 then Complex.one
Chris@10:       else if is_pow 2 i then w (log 2 i)
Chris@10:       else let x = largest_power_smaller_than 2 i in
Chris@10:       let y = i - x in
Chris@10: 	ctimes use_complex_arith (self x) (self y))
Chris@10:     in make_bytwiddle sign use_complex_arith g f
Chris@10:   and twidlen n = 2 * (log 2 (largest_power_smaller_than 2 (2 * n - 1)))
Chris@10:   and twdesc n =
Chris@10:     (List.flatten 
Chris@10:        (List.map 
Chris@10: 	  (fun i -> 
Chris@10: 	    if i > 0 && is_pow 2 i then 
Chris@10: 	      [TW_CEXP, v, i] 
Chris@10: 	    else 
Chris@10: 	      [])
Chris@10: 	  (iota n)))
Chris@10:     @ [(TW_NEXT, 1, 0)]
Chris@10:   in bytwiddle, twidlen, twdesc
Chris@10: 
Chris@10: let twiddle_policy_log3 v use_complex_arith =
Chris@10:   let rec terms_needed i pi s n =
Chris@10:     if (s >= n - 1) then i
Chris@10:     else terms_needed (i + 1) (3 * pi) (s + pi) n
Chris@10:   in
Chris@10:   let rec bytwiddle n sign w f =
Chris@10:     let nterms = terms_needed 0 1 0 n in
Chris@10:     let maxterm = pow 3 (nterms - 1) in
Chris@10:     let g = rec_array (3 * n) (fun self i ->
Chris@10:       if i = 0 then Complex.one
Chris@10:       else if is_pow 3 i then w (log 3 i)
Chris@10:       else if i = (n - 1) && maxterm >= n then
Chris@10: 	w (nterms - 1)
Chris@10:       else let x = smallest_power_larger_than 3 i in
Chris@10:       if (i + i >= x) then
Chris@10: 	let x = min x (n - 1) in
Chris@10: 	  ctimesj use_complex_arith (self (x - i)) (self x)
Chris@10:       else let x = largest_power_smaller_than 3 i in
Chris@10: 	ctimes use_complex_arith (self (i - x)) (self x))
Chris@10:     in make_bytwiddle sign use_complex_arith g f
Chris@10:   and twidlen n = 2 * (terms_needed 0 1 0 n)
Chris@10:   and twdesc n =
Chris@10:     (List.map 
Chris@10:        (fun i -> 
Chris@10: 	  let x = min (pow 3 i) (n - 1) in
Chris@10: 	    TW_CEXP, v, x)
Chris@10:        (iota ((twidlen n) / 2)))
Chris@10:     @ [(TW_NEXT, 1, 0)]
Chris@10:   in bytwiddle, twidlen, twdesc
Chris@10:     
Chris@10: let current_twiddle_policy = ref twiddle_policy_load_all
Chris@10: 
Chris@10: let twiddle_policy use_complex_arith = 
Chris@10:   !current_twiddle_policy use_complex_arith
Chris@10: 
Chris@10: let set_policy x = Arg.Unit (fun () -> current_twiddle_policy := x)
Chris@10: let set_policy_int x = Arg.Int (fun i -> current_twiddle_policy := x i)
Chris@10: 
Chris@10: let undocumented = " Undocumented twiddle policy"
Chris@10: 
Chris@10: let speclist = [
Chris@10:   "-twiddle-load-all", set_policy twiddle_policy_load_all, undocumented;
Chris@10:   "-twiddle-log2", set_policy twiddle_policy_log2, undocumented;
Chris@10:   "-twiddle-log3", set_policy twiddle_policy_log3, undocumented;
Chris@10: ]