comparison src/fftw-3.3.3/genfft/genutil.ml @ 10:37bf6b4a2645

Add FFTW3

+(*
+ * Copyright (c) 1997-1999 Massachusetts Institute of Technology
+ * Copyright (c) 2003, 2007-11 Matteo Frigo
+ * Copyright (c) 2003, 2007-11 Massachusetts Institute of Technology
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+ *
+ *)
+
+(* utilities common to all generators *)
+open Util
+
+let choose_simd a b = if !Simdmagic.simd_mode then b else a
+
+let unique_array n = array n (fun _ -> Unique.make ())
+let unique_array_c n = 
+  array n (fun _ -> 
+    (Unique.make (), Unique.make ()))
+
+let unique_v_array_c veclen n = 
+  array veclen (fun _ ->
+    unique_array_c n)
+
+let locative_array_c n rarr iarr loc vs = 
+  array n (fun i -> 
+    let klass = Unique.make () in
+    let (rloc, iloc) = loc i in
+    (Variable.make_locative rloc klass rarr i vs,
+     Variable.make_locative iloc klass iarr i vs))
+
+let locative_v_array_c veclen n rarr iarr loc vs = 
+  array veclen (fun v ->
+    array n (fun i -> 
+      let klass = Unique.make () in
+      let (rloc, iloc) = loc v i in
+      (Variable.make_locative rloc klass (rarr v) i vs,
+       Variable.make_locative iloc klass (iarr v) i vs)))
+
+let temporary_array n = 
+  array n (fun i -> Variable.make_temporary ())
+
+let temporary_array_c n = 
+  let tmpr = temporary_array n
+  and tmpi = temporary_array n
+  in 
+  array n (fun i -> (tmpr i, tmpi i))
+
+let temporary_v_array_c veclen n =
+  array veclen (fun v -> temporary_array_c n)
+
+let temporary_array_c n = 
+  let tmpr = temporary_array n
+  and tmpi = temporary_array n
+  in 
+  array n (fun i -> (tmpr i, tmpi i))
+
+let load_c (vr, vi) = Complex.make (Expr.Load vr, Expr.Load vi)
+let load_r (vr, vi) = Complex.make (Expr.Load vr, Expr.Num (Number.zero))
+
+let twiddle_array nt w =
+  array (nt/2) (fun i ->
+    let stride = choose_simd (C.SInteger 1) (C.SConst "TWVL") 
+    and klass = Unique.make () in
+    let (refr, refi) = (C.array_subscript w stride (2 * i),
+			C.array_subscript w stride (2 * i + 1))
+    in
+    let (kr, ki) = (Variable.make_constant klass refr,
+		    Variable.make_constant klass refi)  
+    in
+    load_c (kr, ki))
+
+
+let load_array_c n var = array n (fun i -> load_c (var i))
+let load_array_r n var = array n (fun i -> load_r (var i))
+let load_array_hc n var = 
+  array n (fun i -> 
+    if (i < n - i) then
+      load_c (var i)
+    else if (i > n - i) then
+      Complex.times Complex.i (load_c (var (n - i)))
+    else
+      load_r (var i))
+
+let load_v_array_c veclen n var =
+  array veclen (fun v -> load_array_c n (var v))
+
+let store_c (vr, vi) x = [Complex.store_real vr x; Complex.store_imag vi x]
+let store_r (vr, vi) x = Complex.store_real vr x
+let store_i (vr, vi) x = Complex.store_imag vi x
+
+let assign_array_c n dst src =
+  List.flatten
+    (rmap (iota n)
+       (fun i ->
+	 let (ar, ai) = Complex.assign (dst i) (src i)
+	 in [ar; ai]))
+let assign_v_array_c veclen n dst src =
+  List.flatten
+    (rmap (iota veclen)
+       (fun v ->
+	 assign_array_c n (dst v) (src v)))
+
+let vassign_v_array_c veclen n dst src =
+  List.flatten
+    (rmap (iota n) (fun i ->
+      List.flatten
+	(rmap (iota veclen)
+	   (fun v ->
+	     let (ar, ai) = Complex.assign (dst v i) (src v i)
+	     in [ar; ai]))))
+
+let store_array_r n dst src =
+  rmap (iota n)
+    (fun i -> store_r (dst i) (src i))
+
+let store_array_c n dst src =
+  List.flatten
+    (rmap (iota n)
+       (fun i -> store_c (dst i) (src i)))
+
+let store_array_hc n dst src =
+  List.flatten
+    (rmap (iota n)
+       (fun i -> 
+	 if (i < n - i) then
+	   store_c (dst i) (src i)
+	 else if (i > n - i) then
+	   []
+	 else 
+	   [store_r (dst i) (Complex.real (src i))]))
+	
+
+let store_v_array_c veclen n dst src =
+  List.flatten
+    (rmap (iota veclen)
+       (fun v ->
+	 store_array_c n (dst v) (src v)))
+
+
+let elementwise f n a = array n (fun i -> f (a i))
+let conj_array_c = elementwise Complex.conj
+let real_array_c = elementwise Complex.real
+let imag_array_c = elementwise Complex.imag
+
+let elementwise_v f veclen n a = 
+  array veclen (fun v ->
+    array n (fun i -> f (a v i)))
+let conj_v_array_c = elementwise_v Complex.conj
+let real_v_array_c = elementwise_v Complex.real
+let imag_v_array_c = elementwise_v Complex.imag
+
+
+let transpose f i j = f j i
+let symmetrize f i j = if i <= j then f i j else f j i
+
+(* utilities for command-line parsing *)
+let standard_arg_parse_fail _ = failwith "too many arguments"
+
+let dump_dag alist =
+  let fnam = !Magic.dag_dump_file in
+  if (String.length fnam > 0) then
+    let ochan = open_out fnam in
+    begin
+      To_alist.dump (output_string ochan) alist;
+      close_out ochan;
+    end
+
+let dump_alist alist =
+  let fnam = !Magic.alist_dump_file in
+  if (String.length fnam > 0) then
+    let ochan = open_out fnam in
+    begin
+      Expr.dump (output_string ochan) alist;
+      close_out ochan;
+    end
+
+let dump_asched asched =
+  let fnam = !Magic.asched_dump_file in
+  if (String.length fnam > 0) then
+    let ochan = open_out fnam in
+    begin
+      Annotate.dump (output_string ochan) asched;
+      close_out ochan;
+    end
+
+(* utilities for optimization *)
+let standard_scheduler dag =
+  let optim = Algsimp.algsimp dag in
+  let alist = To_alist.to_assignments optim in
+  let _ = dump_alist alist in
+  let _ = dump_dag alist in
+    if !Magic.precompute_twiddles then
+      Schedule.isolate_precomputations_and_schedule alist 
+    else
+      Schedule.schedule alist 
+
+let standard_optimizer dag =
+  let sched = standard_scheduler dag in
+  let annot = Annotate.annotate [] sched in
+  let _ = dump_asched annot in
+  annot
+
+let size = ref None
+let sign = ref (-1)
+
+let speclist = [
+  "-n", Arg.Int(fun i -> size := Some i), " generate a codelet of size <n>";
+  "-sign",
+  Arg.Int(fun i -> 
+    if (i > 0) then
+      sign := 1
+    else
+      sign := (-1)),
+  " sign of transform";
+]
+
+let check_size () =
+  match !size with
+  | Some i -> i
+  | None -> failwith "must specify -n"
+
+let expand_name name = if name = "" then "noname" else name
+
+let declare_register_fcn name =
+  if name = "" then
+    "void NAME(planner *p)\n"
+  else 
+    "void " ^ (choose_simd "X" "XSIMD") ^
+      "(codelet_" ^ name ^ ")(planner *p)\n"
+
+let stringify name = 
+  if name = "" then "STRINGIZE(NAME)" else 
+    choose_simd ("\"" ^ name ^ "\"")
+      ("XSIMD_STRING(\"" ^ name ^ "\")")
+
+let parse user_speclist usage =
+  Arg.parse
+    (user_speclist @ speclist @ Magic.speclist @ Simdmagic.speclist)
+    standard_arg_parse_fail
+    usage
+
+let rec list_to_c = function
+    [] -> ""
+  | [a] -> (string_of_int a)
+  | a :: b -> (string_of_int a) ^ ", " ^ (list_to_c b)
+
+let rec list_to_comma = function
+  | [a; b] -> C.Comma (a, b)
+  | a :: b -> C.Comma (a, list_to_comma b)
+  | _ -> failwith "list_to_comma"
+
+
+type stride = Stride_variable | Fixed_int of int | Fixed_string of string
+
+let either_stride a b =
+  match a with
+    Fixed_int x -> C.SInteger x
+  | Fixed_string x -> C.SConst x
+  | _ -> b
+
+let stride_fixed = function
+    Stride_variable -> false
+  | _ -> true
+
+let arg_to_stride s =
+  try
+    Fixed_int (int_of_string s)
+  with Failure "int_of_string" -> 
+    Fixed_string s
+
+let stride_to_solverparm = function
+    Stride_variable -> "0"
+  | Fixed_int x -> string_of_int x
+  | Fixed_string x -> x
+
+let stride_to_string s = function
+    Stride_variable -> s
+  | Fixed_int x -> string_of_int x
+  | Fixed_string x -> x
+
+(* output the command line *)
+let cmdline () =
+  List.fold_right (fun a b -> a ^ " " ^ b) (Array.to_list Sys.argv) ""
+
+let unparse tree =
+  "/* Generated by: " ^ (cmdline ()) ^ "*/\n\n" ^
+  (C.print_cost tree) ^
+  (if String.length !Magic.inklude > 0 
+  then
+    (Printf.sprintf "#include \"%s\"\n\n" !Magic.inklude)
+  else "") ^
+  (if !Simdmagic.simd_mode then
+    Simd.unparse_function tree
+  else
+    C.unparse_function tree)
+
+let finalize_fcn ast = 
+  let mergedecls = function
+      C.Block (d1, [C.Block (d2, s)]) -> C.Block (d1 @ d2, s)
+    | x -> x
+  and extract_constants =
+    if !Simdmagic.simd_mode then 
+      Simd.extract_constants 
+    else
+      C.extract_constants
+	
+  in mergedecls (C.Block (extract_constants ast, [ast; C.Simd_leavefun]))
+
+let twinstr_to_string vl x =
+  if !Simdmagic.simd_mode then 
+    Twiddle.twinstr_to_simd_string vl x
+  else
+    Twiddle.twinstr_to_c_string x
+
+let make_volatile_stride n x = 
+  C.CCall ("MAKE_VOLATILE_STRIDE", C.Comma((C.Integer n), x))