genfft.ml

FFTW, a collection of fast C routines to compute the Discrete Fourier Transform in one or more dime

  and unparse_var =
    Variable.make_unparser (ioarray, Some iostride) 
      (ioarray, Some iostride) (twarray, None)

  and (_, num_twiddles, _) = Twiddle.twiddle_policy ()

  in let body = Block (
    [Decl ("int", i); Decl ("fftw_complex *", ioarray)],
    [Stmt_assign (ioarraye, ae);
      For (Expr_assign (ie, me),
	   Binop (" > ", ie, Integer 0),
	   Comma (Expr_assign (ie, Plus [ie; Uminus (Integer 1)]),
		  (Comma (Expr_assign (ioarraye, Plus [ioarraye; diste]),
                          (Expr_assign (twarraye, 
					Plus [twarraye;
					      Integer (num_twiddles n)]))))),
	   Asch asch)])
  in let fcnname = name ^ ns
  in let tree = 
    Fcn ("void", fcnname,
	 [Decl ("fftw_complex *", a);
	   Decl ("const fftw_complex *", twarray);
	   Decl ("int", iostride);
	   Decl ("int", m);
	   Decl ("int", dist)],
         body)

  in let desc = codelet_description n dir TWIDDLE tree
  in ((make_c_unparser unparse_var) tree) ^ desc

let athena_twiddle_gen n dir =
  let _ = info "generating..." 
  and (name, sign, generator) = match dir with
    Fft.FORWARD -> "athfft_twiddle_", (-1), Fft.twiddle_dif_gen_expr
  | Fft.BACKWARD -> "athffti_twiddle_", 1, Fft.twiddle_dit_gen_expr in
  let asch = optimize (generator n Symmetry.no_sym Symmetry.no_sym dir)
  and ns = string_of_int n
  and a = "A"
  and i = "i"

  in let ae = make_expr a
  and ie = make_expr i
  and ioarraye = make_expr ioarray
  and twarraye = make_expr twarray

  and unparse_var =
    Variable.make_unparser (ioarray, Some iostride) 
      (ioarray, Some iostride) (twarray, None)

  and (_, num_twiddles, _) = Twiddle.twiddle_policy ()

  in let body = Block (
    [Decl ("int", i); Decl ("fftw_complex *", ioarray)],
    [Stmt_assign (ioarraye, ae);
      For (Expr_assign (ie, make_expr iostride),
	   Binop (" > ", ie, Integer 0),
	   Comma (Expr_assign (ie, Plus [ie; Uminus (Integer 1)]),
		  (Comma (Expr_assign (ioarraye, Plus [ioarraye; Integer 1]),
                          (Expr_assign (twarraye, 
					Plus [twarraye;
					      Integer (num_twiddles n)]))))),
	   Asch asch)])
  in let fcnname = name ^ ns
  in let tree = 
    Fcn ("void", fcnname,
	 [Decl ("fftw_complex *", a);
	   Decl ("const fftw_complex *", twarray);
	   Decl ("int", iostride)],
         body)
  and prologue = 
    "#include \"athfft.h\"\n\n"
  in prologue ^ ((make_c_unparser unparse_var) tree)

let twiddle_gen n dir =
  if (!Magic.athenafft) then
    athena_twiddle_gen n dir
  else
    fftw_twiddle_gen n dir

let arrayX = "X"
let arrayY = "Y"

let hc2hc_gen n dir =
  let _ = info "generating..." in
  let (zeroth_elements, middle_elements, final_elements, name, sign, 
       make_variable_unparser) =
    match dir with
      Fft.FORWARD -> (
	optimize (Fft.no_twiddle_gen_expr n Symmetry.real_sym dir),
	optimize (Fft.twiddle_dit_gen_expr n Symmetry.no_sym 
		    Symmetry.middle_hc2hc_forward_sym dir),
	optimize (Fft.no_twiddle_gen_expr (2 * n) 
		    Symmetry.final_hc2hc_forward_sym dir),
	"fftw_hc2hc_forward_", 
	(-1),
	Variable.make_hc2hc_forward_unparser)
    | Fft.BACKWARD -> (
	optimize (Fft.no_twiddle_gen_expr n Symmetry.hermitian_sym dir),
	optimize (Fft.twiddle_dif_gen_expr n Symmetry.middle_hc2hc_backward_sym
		    Symmetry.no_sym dir),
	optimize (Fft.no_twiddle_gen_expr (2 * n) 
		    Symmetry.final_hc2hc_backward_sym dir),
	"fftw_hc2hc_backward_", 
	1,
	Variable.make_hc2hc_backward_unparser)
  and ns = string_of_int n
  and m = "m"
  and dist = "dist"
  and a = "A"
  and i = "i"

  in let me = make_expr m
  and diste = make_expr dist
  and iostridee = make_expr iostride
  and ae = make_expr a
  and ie = make_expr i
  and arrayXe = make_expr arrayX
  and arrayYe = make_expr arrayY
  and twarraye = make_expr twarray
  and unparse_var = make_variable_unparser n (arrayX, Some iostride) 
      (arrayY, Some iostride) (twarray, None)

  and (_, num_twiddles, _) = Twiddle.twiddle_policy ()

  in let body = Block (
    [
    Decl ("int", i); 
    Decl ("fftw_real *", arrayX);
    Decl ("fftw_real *", arrayY)],
    [
    Stmt_assign (arrayXe, ae);
    Stmt_assign (arrayYe, Plus [ae; Times (Integer n, iostridee)]);
    Asch zeroth_elements;
    Stmt_assign (arrayXe, Plus [arrayXe; diste]);
    Stmt_assign (arrayYe, Plus [arrayYe; Uminus diste]);
    For (Expr_assign (ie, Integer 2),
	 Binop (" < ", ie, me),
	 Comma (Expr_assign (ie, Plus [ie; Integer 2]),
		(Comma 
		   (Comma 
		      (Expr_assign (arrayXe, Plus [arrayXe; diste]),
		       Expr_assign (arrayYe, Plus [arrayYe; Uminus diste])),
                    (Expr_assign (twarraye, 
				  Plus [twarraye;
					 Integer (num_twiddles n)]))))),
	 Asch middle_elements);
    If (Binop (" == ", ie, me),
	Asch final_elements)])
  in let fcnname = name ^ ns
  in let tree = 
    Fcn ("void", fcnname,
	 [Decl ("fftw_real *", a);
	   Decl ("const fftw_complex *", twarray);
	   Decl ("int", iostride);
	   Decl ("int", m);
	   Decl ("int", dist)],
         body)

  in let desc = codelet_description n dir HC2HC tree
  in ((make_c_unparser unparse_var) tree) ^ desc

let usage = "Usage: genfft [-notwiddle | -notwiddleinv | -twiddle | -twiddleinv| -real2hc | -hc2hc-forward |  -hc2hc-backward ] <number>"

type mode = 
  | GEN_NOTHING
  | GEN_TWIDDLE of int
  | GEN_NOTWID of int
  | GEN_TWIDDLEI of int
  | GEN_NOTWIDI of int
  | GEN_REAL2HC of int
  | GEN_HC2REAL of int
  | GEN_HC2HC_FORWARD of int
  | GEN_HC2HC_BACKWARD of int
  | GEN_REAL_EVEN of int
  | GEN_REAL_ODD of int
  | GEN_REAL_EVEN2 of int
  | GEN_REAL_ODD2 of int
  | GEN_REAL_EVEN_TWIDDLE of int
  | GEN_REAL_ODD_TWIDDLE of int
  | GEN_MP3MDCT of int

let mode = ref GEN_NOTHING

let undocumented = " Undocumented voodoo parameter"

let main () =
  Arg.parse [
  "-notwiddle", Arg.Int(fun i -> mode := GEN_NOTWID i), "<n> : Generate a no twiddle codelet of size <n>";
  "-notwiddleinv", Arg.Int(fun i -> mode := GEN_NOTWIDI i), "<n> : Generate a no twiddle inverse codelet of size <n>";
  "-twiddle", Arg.Int(fun i -> mode := GEN_TWIDDLE i), "<n> : Generate a twiddle codelet of size <n>";
  "-twiddleinv", Arg.Int(fun i -> mode := GEN_TWIDDLEI i), "<n> : Generate a twiddle inverse codelet of size <n>";
  "-real2hc", Arg.Int(fun i -> mode := GEN_REAL2HC i), "<n> : Generate a real to halfcomplex codelet of size <n>";
  "-hc2hc-forward", Arg.Int(fun i -> mode := GEN_HC2HC_FORWARD i), "<n> : Generate a forward halfcomplex to halfcomplex codelet of size <n>";
  "-hc2hc-backward", Arg.Int(fun i -> mode := GEN_HC2HC_BACKWARD i), "<n> : Generate a backward halfcomplex to halfcomplex codelet of size <n>";
  "-hc2real", Arg.Int(fun i -> mode := GEN_HC2REAL i), "<n> : Generate a halfcomplex to real codelet of size <n>";
  "-realeven", Arg.Int(fun i -> mode := GEN_REAL_EVEN i), "<n> : Generate a real even codelet of size <n>";
  "-realodd", Arg.Int(fun i -> mode := GEN_REAL_ODD i), "<n> : Generate a real odd codelet of size <n>";
  "-realeven2", Arg.Int(fun i -> mode := GEN_REAL_EVEN2 i), "<n> : Generate a real even-2 codelet of size <n>";
  "-realodd2", Arg.Int(fun i -> mode := GEN_REAL_ODD2 i), "<n> : Generate a real odd-2 codelet of size <n>";
  "-realeventwiddle", Arg.Int(fun i -> mode := GEN_REAL_EVEN_TWIDDLE i), "<n> : Generate a real even twiddle codelet of size <n>";
  "-realoddtwiddle", Arg.Int(fun i -> mode := GEN_REAL_ODD_TWIDDLE i), "<n> : Generate a real odd twiddle codelet of size <n>";
  "-mp3mdct", Arg.Int(fun i -> mode := GEN_MP3MDCT i), "<n> : Generate a MPEG3 MDCT codelet of size <n>";

  "-verbose", 
  Arg.Unit(fun () -> Magic.verbose := true),
  " Enable verbose logging messages to stderr";


  "-inline-konstants", 
  Arg.Unit(fun () -> Magic.inline_konstants := true),
  " Inline floating point constants";
  "-no-inline-konstants", 
  Arg.Unit(fun () -> Magic.inline_konstants := false),
  " Do not inline floating point constants";

  "-rader-min", Arg.Int(fun i -> Magic.rader_min := i),
  "<n> : Use Rader's algorithm for prime sizes >= <n>";

  "-magic-alternate-convolution", 
  Arg.Int(fun i -> Magic.alternate_convolution := i),
  undocumented;

  "-magic-athenafft", 
  Arg.Unit(fun () -> Magic.athenafft := true),
  undocumented;

  "-magic-window", Arg.Int(fun i -> Magic.window := i), undocumented;
  "-magic-variables", Arg.Int(fun i -> Magic.number_of_variables := i),
  undocumented;

  "-magic-loopo", 
  Arg.Unit(fun () -> Magic.loopo := true),
  undocumented;
  "-magic-loopi", 
  Arg.Unit(fun () -> Magic.loopo := false),
  undocumented;

  "-magic-times-3-3", 
  Arg.Unit(fun () -> Magic.times_3_3 := true),
  undocumented;
  "-magic-times-4-2", 
  Arg.Unit(fun () -> Magic.times_3_3 := false),
  undocumented;

  "-magic-inline-single", 
  Arg.Unit(fun () -> Magic.inline_single := true),
  undocumented;
  "-magic-no-inline-single", 
  Arg.Unit(fun () -> Magic.inline_single := false),
  undocumented;

  "-magic-inline-loads", 
  Arg.Unit(fun () -> Magic.inline_loads := true),
  undocumented;
  "-magic-no-inline-loads", 
  Arg.Unit(fun () -> Magic.inline_loads := false),
  undocumented;

  "-magic-enable-fma", 
  Arg.Unit(fun () -> Magic.enable_fma := true),
  undocumented;
  "-magic-disable-fma", 
  Arg.Unit(fun () -> Magic.enable_fma := false),
  undocumented;

  "-magic-enable-fma-expansion", 
  Arg.Unit(fun () -> Magic.enable_fma_expansion := true),
  undocumented;
  "-magic-disable-fma-expansion", 
  Arg.Unit(fun () -> Magic.enable_fma_expansion := false),
  undocumented;

  "-magic-collect-common-twiddle", 
  Arg.Unit(fun () -> Magic.collect_common_twiddle := true),
  undocumented;
  "-magic-no-collect-common-twiddle", 
  Arg.Unit(fun () -> Magic.collect_common_twiddle := false),
  undocumented;

  "-magic-collect-common-inputs", 
  Arg.Unit(fun () -> Magic.collect_common_inputs := true),
  undocumented;
  "-magic-no-collect-common-inputs", 
  Arg.Unit(fun () -> Magic.collect_common_inputs := false),
  undocumented;

  "-magic-alignment-check", 
  Arg.Unit(fun () -> Magic.alignment_check := true),
  undocumented;

  "-magic-use-wsquare", 
  Arg.Unit(fun () -> Magic.use_wsquare := true),
  undocumented;
  "-magic-no-wsquare", 
  Arg.Unit(fun () -> Magic.use_wsquare := false),
  undocumented;

  "-magic-twiddle-load-all", 
  Arg.Unit(fun () -> Magic.twiddle_policy := Magic.TWIDDLE_LOAD_ALL),
  undocumented;
  "-magic-twiddle-iter", 
  Arg.Unit(fun () -> Magic.twiddle_policy := Magic.TWIDDLE_ITER),
  undocumented;
  "-magic-twiddle-load-odd", 
  Arg.Unit(fun () -> Magic.twiddle_policy := Magic.TWIDDLE_LOAD_ODD),
  undocumented;
  "-magic-twiddle-square1", 
  Arg.Unit(fun () -> Magic.twiddle_policy := Magic.TWIDDLE_SQUARE1),
  undocumented;
  "-magic-twiddle-square2", 
  Arg.Unit(fun () -> Magic.twiddle_policy := Magic.TWIDDLE_SQUARE2),
  undocumented;
  "-magic-twiddle-square3", 
  Arg.Unit(fun () -> Magic.twiddle_policy := Magic.TWIDDLE_SQUARE3),
  undocumented;
] (fun _ -> failwith "too many arguments") usage;

  let out = 
    match !mode with
    | GEN_TWIDDLE i -> (twiddle_gen i Fft.FORWARD)
    | GEN_TWIDDLEI i -> (twiddle_gen i Fft.BACKWARD)
    | GEN_NOTWID i -> (no_twiddle_gen i Fft.FORWARD)
    | GEN_NOTWIDI i -> (no_twiddle_gen i Fft.BACKWARD)
    | GEN_REAL2HC i -> (real2hc_gen i)
    | GEN_MP3MDCT i -> (mp3mdct_gen i)
    | GEN_HC2HC_FORWARD i -> (hc2hc_gen i Fft.FORWARD)
    | GEN_HC2REAL i -> (hc2real_gen i)
    | GEN_HC2HC_BACKWARD i -> (hc2hc_gen i Fft.BACKWARD)
    | GEN_REAL_EVEN i -> (realeven_gen i)
    | GEN_REAL_ODD i -> (realodd_gen i)
    | GEN_REAL_EVEN2 i -> (realeven2_gen i)
    | GEN_REAL_ODD2 i -> (realodd2_gen i)
    | _ -> failwith "one of -notwiddle, -notwiddleinv, -twiddle, -twiddleinv, -real2hc, -hc2real, -hc2hc-forward, or -hc2hc-forward must be specified"

  in begin
    print_string out;
    exit 0;
  end

let _ = main()