← Back to branch summary

~ubuntu-branches/ubuntu/raring/fftw3/raring-proposed

« back to all changes in this revision

Viewing changes to genfft/gen_notw_noinline.ml

  • Committer: Bazaar Package Importer
  • Author(s): Paul Brossier
  • Date: 2006-05-31 13:44:05 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060531134405-ol9hrbg6bh81sg0c
Tags: 3.1.1-1
http://bugs.debian.org/350327
http://bugs.debian.org/338487
http://bugs.debian.org/338501
* New upstream release (closes: #350327, #338487, #338501)
* Add --enable-portable-binary to use -mtune instead of -march
* Use --with-gcc-arch=G5 / pentium4 on powerpc / i386
* Updated Standards-Version

Show diffs side-by-side

added added

removed removed

Lines of Context:
genfft/gen_notw_noinline.ml
1
 
(*
2
 
 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
3
 
 * Copyright (c) 2003 Matteo Frigo
4
 
 * Copyright (c) 2003 Massachusetts Institute of Technology
5
 
 *
6
 
 * This program is free software; you can redistribute it and/or modify
7
 
 * it under the terms of the GNU General Public License as published by
8
 
 * the Free Software Foundation; either version 2 of the License, or
9
 
 * (at your option) any later version.
10
 
 *
11
 
 * This program is distributed in the hope that it will be useful,
12
 
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14
 
 * GNU General Public License for more details.
15
 
 *
16
 
 * You should have received a copy of the GNU General Public License
17
 
 * along with this program; if not, write to the Free Software
18
 
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
19
 
 *
20
 
 *)
21
 
(* $Id: gen_notw_noinline.ml,v 1.1 2003/04/17 11:07:19 athena Exp $ *)
22
 
 
23
 
open Util
24
 
open Genutil
25
 
open C
26
 
 
27
 
let cvsid = "$Id: gen_notw_noinline.ml,v 1.1 2003/04/17 11:07:19 athena Exp $"
28
 
 
29
 
let usage = "Usage: " ^ Sys.argv.(0) ^ " -n <number>"
30
 
 
31
 
let uistride = ref Stride_variable
32
 
let uostride = ref Stride_variable
33
 
let uivstride = ref Stride_variable
34
 
let uovstride = ref Stride_variable
35
 
 
36
 
let speclist = [
37
 
  "-with-istride",
38
 
  Arg.String(fun x -> uistride := arg_to_stride x),
39
 
  " specialize for given input stride";
40
 
 
41
 
  "-with-ostride",
42
 
  Arg.String(fun x -> uostride := arg_to_stride x),
43
 
  " specialize for given output stride";
44
 
 
45
 
  "-with-ivstride",
46
 
  Arg.String(fun x -> uivstride := arg_to_stride x),
47
 
  " specialize for given input vector stride";
48
 
 
49
 
  "-with-ovstride",
50
 
  Arg.String(fun x -> uovstride := arg_to_stride x),
51
 
  " specialize for given output vector stride"
52
 
] 
53
 
 
54
 
let generate n =
55
 
  let riarray = "ri"
56
 
  and iiarray = "ii"
57
 
  and roarray = "ro"
58
 
  and ioarray = "io"
59
 
  and istride = "is"
60
 
  and ostride = "os" 
61
 
  in
62
 
 
63
 
  let sign = !Genutil.sign 
64
 
  and name = !Magic.codelet_name in
65
 
  let ename = expand_name name in
66
 
  let name0 = ename ^ "_0" in
67
 
 
68
 
  let vl = choose_simd "1" "VL"
69
 
  in
70
 
 
71
 
  let vistride = either_stride (!uistride) (C.SVar istride)
72
 
  and vostride = either_stride (!uostride) (C.SVar ostride)
73
 
  in
74
 
 
75
 
  let _ = Simd.ovs := stride_to_string "ovs" !uovstride in
76
 
  let _ = Simd.ivs := stride_to_string "ivs" !uivstride in
77
 
 
78
 
  let locations = unique_array_c n in
79
 
  let input = 
80
 
    locative_array_c n 
81
 
      (C.array_subscript riarray vistride)
82
 
      (C.array_subscript iiarray vistride)
83
 
      locations in
84
 
  let output = Fft.dft sign n (load_array_c n input) in
85
 
  let oloc = 
86
 
    locative_array_c n 
87
 
      (C.array_subscript roarray vostride)
88
 
      (C.array_subscript ioarray vostride)
89
 
      locations in
90
 
  let odag = store_array_c n oloc output in
91
 
  let annot = standard_optimizer odag in
92
 
 
93
 
  let tree0 =
94
 
    Fcn ("static void", name0,
95
 
         ([Decl (C.constrealtypep, riarray);
96
 
           Decl (C.constrealtypep, iiarray);
97
 
           Decl (C.realtypep, roarray);
98
 
           Decl (C.realtypep, ioarray)] 
99
 
          @ (if stride_fixed !uistride then [] 
100
 
               else [Decl (C.stridetype, istride)])
101
 
          @ (if stride_fixed !uostride then [] 
102
 
               else [Decl (C.stridetype, ostride)])
103
 
          @ (choose_simd []
104
 
               (if stride_fixed !uivstride then [] else 
105
 
               [Decl ("int", !Simd.ivs)]))
106
 
          @ (choose_simd []
107
 
               (if stride_fixed !uovstride then [] else 
108
 
               [Decl ("int", !Simd.ovs)]))
109
 
         ),
110
 
         add_constants (Asch annot))
111
 
 
112
 
  in let loop =
113
 
    "static void " ^ ename ^
114
 
      "(const " ^ C.realtype ^ " *ri, const " ^ C.realtype ^ " *ii, "
115
 
      ^ C.realtype ^ " *ro, " ^ C.realtype ^ " *io,\n" ^ 
116
 
      C.stridetype ^ " is, " ^  C.stridetype ^ " os, " ^ 
117
 
      " int v, int ivs, int ovs)\n" ^
118
 
    "{\n" ^
119
 
    "int i;\n" ^
120
 
    "for (i = v; i > 0; i -= " ^ vl ^ ") {\n" ^
121
 
      name0 ^ 
122
 
        "(ri, ii, ro, io" ^
123
 
           (if stride_fixed !uistride then "" else ", is") ^ 
124
 
           (if stride_fixed !uostride then "" else ", os") ^ 
125
 
           (choose_simd ""
126
 
              (if stride_fixed !uivstride then "" else ", ivs")) ^ 
127
 
           (choose_simd ""
128
 
              (if stride_fixed !uovstride then "" else ", ovs")) ^ 
129
 
          ");\n" ^
130
 
      (choose_simd
131
 
         (Printf.sprintf
132
 
            "ri += ivs; ii += ivs; ro += %s; io += %s;\n"
133
 
            !Simd.ovs !Simd.ovs)
134
 
         (Printf.sprintf
135
 
            "ri += VL * %s; ii += VL * %s; ro += VL * %s; io += VL * %s;\n"
136
 
            !Simd.ivs !Simd.ivs !Simd.ovs !Simd.ovs)) ^
137
 
    "}\n}\n\n"
138
 
 
139
 
  and desc = 
140
 
    Printf.sprintf 
141
 
      "static const kdft_desc desc = { %d, \"%s\", %s, &GENUS, %s, %s, %s, %s };\n"
142
 
      n name (flops_of tree0) 
143
 
      (stride_to_solverparm !uistride) (stride_to_solverparm !uostride)
144
 
      (choose_simd "0" (stride_to_solverparm !uivstride))
145
 
      (choose_simd "0" (stride_to_solverparm !uovstride))
146
 
 
147
 
  and init =
148
 
    (declare_register_fcn name) ^
149
 
    "{" ^
150
 
    "  X(kdft_register)(p, " ^ ename ^ ", &desc);\n" ^
151
 
    "}\n"
152
 
 
153
 
  in ((unparse cvsid tree0) ^ "\n" ^ 
154
 
      loop ^ 
155
 
      desc ^
156
 
      init)
157
 
 
158
 
let main () =
159
 
  begin
160
 
    parse speclist usage;
161
 
    print_string (generate (check_size ()));
162
 
  end
163
 
 
164
 
let _ = main()