← Back to branch summary

~diresu/blender/blender-command-port

« back to all changes in this revision

Viewing changes to extern/fftw/genfft/gen_notw.ml

  • Committer: theeth
  • Date: 2008-10-14 16:52:04 UTC
  • Revision ID: vcs-imports@canonical.com-20081014165204-r32w2gm6s0osvdhn
copy back trunk

Show diffs side-by-side

added added

removed removed

Lines of Context:
extern/fftw/genfft/gen_notw.ml
 
1
(*
 
2
 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
 
3
 * Copyright (c) 2003, 2006 Matteo Frigo
 
4
 * Copyright (c) 2003, 2006 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.ml,v 1.30 2006-02-12 23:34:12 athena Exp $ *)
 
22
 
 
23
open Util
 
24
open Genutil
 
25
open C
 
26
 
 
27
let cvsid = "$Id: gen_notw.ml,v 1.30 2006-02-12 23:34:12 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 nonstandard_optimizer list_of_buddy_stores dag =
 
55
  let sched = standard_scheduler dag in
 
56
  let annot = Annotate.annotate list_of_buddy_stores sched in
 
57
  let _ = dump_asched annot in
 
58
  annot
 
59
 
 
60
let generate n =
 
61
  let riarray = "ri"
 
62
  and iiarray = "ii"
 
63
  and roarray = "ro"
 
64
  and ioarray = "io"
 
65
  and istride = "is"
 
66
  and ostride = "os" 
 
67
  and i = "i" 
 
68
  and v = "v"
 
69
  in
 
70
 
 
71
  let sign = !Genutil.sign 
 
72
  and name = !Magic.codelet_name
 
73
  and byvl x = choose_simd x (ctimes (CVar "(2 * VL)", x))  in
 
74
  let ename = expand_name name in
 
75
 
 
76
  let vistride = either_stride (!uistride) (C.SVar istride)
 
77
  and vostride = either_stride (!uostride) (C.SVar ostride)
 
78
  in
 
79
 
 
80
  let _ = Simd.ovs := stride_to_string "ovs" !uovstride in
 
81
  let _ = Simd.ivs := stride_to_string "ivs" !uivstride in
 
82
 
 
83
  let locations = unique_array_c n in
 
84
  let input = 
 
85
    locative_array_c n 
 
86
      (C.array_subscript riarray vistride)
 
87
      (C.array_subscript iiarray vistride)
 
88
      locations in
 
89
  let output = Fft.dft sign n (load_array_c n input) in
 
90
  let oloc = 
 
91
    locative_array_c n 
 
92
      (C.array_subscript roarray vostride)
 
93
      (C.array_subscript ioarray vostride)
 
94
      locations in
 
95
  let list_of_buddy_stores =
 
96
    let k = !Simdmagic.store_multiple in
 
97
    if (k > 1) then
 
98
      if (n mod k == 0) then
 
99
        List.append
 
100
          (List.map 
 
101
             (fun i -> List.map (fun j -> (fst (oloc (k * i + j)))) (iota k))
 
102
             (iota (n / k)))
 
103
          (List.map 
 
104
             (fun i -> List.map (fun j -> (snd (oloc (k * i + j)))) (iota k))
 
105
             (iota (n / k)))
 
106
      else failwith "invalid n for -store-multiple"
 
107
    else []
 
108
  in
 
109
 
 
110
  let odag = store_array_c n oloc output in
 
111
  let annot = nonstandard_optimizer list_of_buddy_stores odag in
 
112
 
 
113
  let body = Block (
 
114
    [Decl ("INT", i)],
 
115
    [For (Expr_assign (CVar i, CVar v),
 
116
          Binop (" > ", CVar i, Integer 0),
 
117
          list_to_comma 
 
118
            [Expr_assign (CVar i, CPlus [CVar i; CUminus (byvl (Integer 1))]);
 
119
             Expr_assign (CVar riarray, CPlus [CVar riarray; 
 
120
                                               byvl (CVar !Simd.ivs)]);
 
121
             Expr_assign (CVar iiarray, CPlus [CVar iiarray; 
 
122
                                               byvl (CVar !Simd.ivs)]);
 
123
             Expr_assign (CVar roarray, CPlus [CVar roarray; 
 
124
                                               byvl (CVar !Simd.ovs)]);
 
125
             Expr_assign (CVar ioarray, CPlus [CVar ioarray; 
 
126
                                               byvl (CVar !Simd.ovs)]);
 
127
             make_volatile_stride (CVar istride);
 
128
             make_volatile_stride (CVar ostride)
 
129
           ],
 
130
          Asch annot)
 
131
   ])
 
132
  in
 
133
 
 
134
  let tree =
 
135
    Fcn ((if !Magic.standalone then "void" else "static void"), ename,
 
136
         ([Decl (C.constrealtypep, riarray);
 
137
           Decl (C.constrealtypep, iiarray);
 
138
           Decl (C.realtypep, roarray);
 
139
           Decl (C.realtypep, ioarray);
 
140
           Decl (C.stridetype, istride);
 
141
           Decl (C.stridetype, ostride);
 
142
           Decl ("INT", v);
 
143
           Decl ("INT", "ivs");
 
144
           Decl ("INT", "ovs")]),
 
145
         add_constants body)
 
146
 
 
147
  in let desc = 
 
148
    Printf.sprintf 
 
149
      "static const kdft_desc desc = { %d, %s, %s, &GENUS, %s, %s, %s, %s };\n"
 
150
      n (stringify name) (flops_of tree) 
 
151
      (stride_to_solverparm !uistride) (stride_to_solverparm !uostride)
 
152
      (choose_simd "0" (stride_to_solverparm !uivstride))
 
153
      (choose_simd "0" (stride_to_solverparm !uovstride))
 
154
 
 
155
  and init =
 
156
    (declare_register_fcn name) ^
 
157
    "{" ^
 
158
    "  X(kdft_register)(p, " ^ ename ^ ", &desc);\n" ^
 
159
    "}\n"
 
160
 
 
161
  in ((unparse cvsid tree) ^ "\n" ^ 
 
162
      (if !Magic.standalone then "" else desc ^ init))
 
163
 
 
164
let main () =
 
165
  begin
 
166
    parse speclist usage;
 
167
    print_string (generate (check_size ()));
 
168
  end
 
169
 
 
170
let _ = main()