annotate src/fftw-3.3.8/genfft/gen_twiddle.ml @ 168:ceec0dd9ec9c

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 <cannam@all-day-breakfast.com>
date Fri, 07 Feb 2020 11:51:13 +0000
parents bd3cc4d1df30
children
rev   line source
cannam@167 1 (*
cannam@167 2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
cannam@167 3 * Copyright (c) 2003, 2007-14 Matteo Frigo
cannam@167 4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
cannam@167 5 *
cannam@167 6 * This program is free software; you can redistribute it and/or modify
cannam@167 7 * it under the terms of the GNU General Public License as published by
cannam@167 8 * the Free Software Foundation; either version 2 of the License, or
cannam@167 9 * (at your option) any later version.
cannam@167 10 *
cannam@167 11 * This program is distributed in the hope that it will be useful,
cannam@167 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
cannam@167 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
cannam@167 14 * GNU General Public License for more details.
cannam@167 15 *
cannam@167 16 * You should have received a copy of the GNU General Public License
cannam@167 17 * along with this program; if not, write to the Free Software
cannam@167 18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
cannam@167 19 *
cannam@167 20 *)
cannam@167 21
cannam@167 22 open Util
cannam@167 23 open Genutil
cannam@167 24 open C
cannam@167 25
cannam@167 26
cannam@167 27 type ditdif = DIT | DIF
cannam@167 28 let ditdif = ref DIT
cannam@167 29 let usage = "Usage: " ^ Sys.argv.(0) ^ " -n <number> [ -dit | -dif ]"
cannam@167 30
cannam@167 31 let urs = ref Stride_variable
cannam@167 32 let ums = ref Stride_variable
cannam@167 33
cannam@167 34 let speclist = [
cannam@167 35 "-dit",
cannam@167 36 Arg.Unit(fun () -> ditdif := DIT),
cannam@167 37 " generate a DIT codelet";
cannam@167 38
cannam@167 39 "-dif",
cannam@167 40 Arg.Unit(fun () -> ditdif := DIF),
cannam@167 41 " generate a DIF codelet";
cannam@167 42
cannam@167 43 "-with-rs",
cannam@167 44 Arg.String(fun x -> urs := arg_to_stride x),
cannam@167 45 " specialize for given i/o stride";
cannam@167 46
cannam@167 47 "-with-ms",
cannam@167 48 Arg.String(fun x -> ums := arg_to_stride x),
cannam@167 49 " specialize for given ms"
cannam@167 50 ]
cannam@167 51
cannam@167 52 let generate n =
cannam@167 53 let rioarray = "ri"
cannam@167 54 and iioarray = "ii"
cannam@167 55 and rs = "rs"
cannam@167 56 and twarray = "W"
cannam@167 57 and m = "m" and mb = "mb" and me = "me" and ms = "ms" in
cannam@167 58
cannam@167 59 let sign = !Genutil.sign
cannam@167 60 and name = !Magic.codelet_name
cannam@167 61 and byvl x = choose_simd x (ctimes (CVar "(2 * VL)", x)) in
cannam@167 62 let ename = expand_name name in
cannam@167 63
cannam@167 64 let (bytwiddle, num_twiddles, twdesc) = Twiddle.twiddle_policy 0 false in
cannam@167 65 let nt = num_twiddles n in
cannam@167 66
cannam@167 67 let byw = bytwiddle n sign (twiddle_array nt twarray) in
cannam@167 68
cannam@167 69 let vrs = either_stride (!urs) (C.SVar rs) in
cannam@167 70 let sms = stride_to_string "ms" !ums in
cannam@167 71
cannam@167 72 let locations = unique_array_c n in
cannam@167 73 let iloc =
cannam@167 74 locative_array_c n
cannam@167 75 (C.array_subscript rioarray vrs)
cannam@167 76 (C.array_subscript iioarray vrs)
cannam@167 77 locations sms
cannam@167 78 and oloc =
cannam@167 79 locative_array_c n
cannam@167 80 (C.array_subscript rioarray vrs)
cannam@167 81 (C.array_subscript iioarray vrs)
cannam@167 82 locations sms
cannam@167 83 in
cannam@167 84 let liloc = load_array_c n iloc in
cannam@167 85 let output =
cannam@167 86 match !ditdif with
cannam@167 87 | DIT -> array n (Fft.dft sign n (byw liloc))
cannam@167 88 | DIF -> array n (byw (Fft.dft sign n liloc))
cannam@167 89 in
cannam@167 90 let odag = store_array_c n oloc output in
cannam@167 91 let annot = standard_optimizer odag in
cannam@167 92
cannam@167 93 let vm = CVar m and vmb = CVar mb and vme = CVar me in
cannam@167 94
cannam@167 95 let body = Block (
cannam@167 96 [Decl ("INT", m)],
cannam@167 97 [For (list_to_comma
cannam@167 98 [Expr_assign (vm, vmb);
cannam@167 99 Expr_assign (CVar twarray,
cannam@167 100 CPlus [CVar twarray;
cannam@167 101 ctimes (vmb, Integer nt)])],
cannam@167 102 Binop (" < ", vm, vme),
cannam@167 103 list_to_comma
cannam@167 104 [Expr_assign (vm, CPlus [vm; byvl (Integer 1)]);
cannam@167 105 Expr_assign (CVar rioarray, CPlus [CVar rioarray;
cannam@167 106 byvl (CVar sms)]);
cannam@167 107 Expr_assign (CVar iioarray, CPlus [CVar iioarray;
cannam@167 108 byvl (CVar sms)]);
cannam@167 109 Expr_assign (CVar twarray, CPlus [CVar twarray;
cannam@167 110 byvl (Integer nt)]);
cannam@167 111 make_volatile_stride (2*n) (CVar rs)
cannam@167 112 ],
cannam@167 113 Asch annot)])
cannam@167 114 in
cannam@167 115
cannam@167 116 let tree =
cannam@167 117 Fcn (((if !Magic.standalone then "" else "static ") ^ "void"),
cannam@167 118 ename,
cannam@167 119 [Decl (C.realtypep, rioarray);
cannam@167 120 Decl (C.realtypep, iioarray);
cannam@167 121 Decl (C.constrealtypep, twarray);
cannam@167 122 Decl (C.stridetype, rs);
cannam@167 123 Decl ("INT", mb);
cannam@167 124 Decl ("INT", me);
cannam@167 125 Decl ("INT", ms)],
cannam@167 126 finalize_fcn body)
cannam@167 127 in
cannam@167 128 let twinstr =
cannam@167 129 Printf.sprintf "static const tw_instr twinstr[] = %s;\n\n"
cannam@167 130 (twinstr_to_string "(2 * VL)" (twdesc n))
cannam@167 131 and desc =
cannam@167 132 Printf.sprintf
cannam@167 133 "static const ct_desc desc = {%d, %s, twinstr, &GENUS, %s, %s, %s, %s};\n\n"
cannam@167 134 n (stringify name) (flops_of tree)
cannam@167 135 (stride_to_solverparm !urs) "0"
cannam@167 136 (stride_to_solverparm !ums)
cannam@167 137 and register =
cannam@167 138 match !ditdif with
cannam@167 139 | DIT -> "X(kdft_dit_register)"
cannam@167 140 | DIF -> "X(kdft_dif_register)"
cannam@167 141
cannam@167 142 in
cannam@167 143 let init =
cannam@167 144 "\n" ^
cannam@167 145 twinstr ^
cannam@167 146 desc ^
cannam@167 147 (declare_register_fcn name) ^
cannam@167 148 (Printf.sprintf "{\n%s(p, %s, &desc);\n}" register ename)
cannam@167 149 in
cannam@167 150
cannam@167 151 (unparse tree) ^ "\n" ^
cannam@167 152 (if !Magic.standalone then "" else init)
cannam@167 153
cannam@167 154
cannam@167 155 let main () =
cannam@167 156 begin
cannam@167 157 parse (speclist @ Twiddle.speclist) usage;
cannam@167 158 print_string (generate (check_size ()));
cannam@167 159 end
cannam@167 160
cannam@167 161 let _ = main()