← Back to branch summary

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

« back to all changes in this revision

Viewing changes to genfft/c.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/c.ml
1
1
(*
2
2
 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
3
 
 * Copyright (c) 2003 Matteo Frigo
4
 
 * Copyright (c) 2003 Massachusetts Institute of Technology
 
3
 * Copyright (c) 2003, 2006 Matteo Frigo
 
4
 * Copyright (c) 2003, 2006 Massachusetts Institute of Technology
5
5
 *
6
6
 * This program is free software; you can redistribute it and/or modify
7
7
 * it under the terms of the GNU General Public License as published by
18
18
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
19
19
 *
20
20
 *)
21
 
(* $Id: c.ml,v 1.19 2003/04/13 20:46:12 athena Exp $ *)
 
21
(* $Id: c.ml,v 1.30 2006-02-12 23:34:12 athena Exp $ *)
22
22
 
23
23
(*
24
24
 * This module contains the definition of a C-like abstract
43
43
 ***********************************)
44
44
type c_decl = 
45
45
  | Decl of string * string
46
 
  | Idecl of string * string * string (* decl with initializer *)
47
 
  | Adecl of string * string * int (* array declaration *)
48
46
  | Tdecl of string                (* arbitrary text declaration *)
49
47
 
50
48
and c_ast =
59
57
  | Comma of c_ast * c_ast
60
58
  | Integer of int
61
59
  | CVar of string
 
60
  | CCall of string * c_ast
62
61
  | CPlus of c_ast list
63
 
  | CTimes of c_ast * c_ast
 
62
  | ITimes of c_ast * c_ast
64
63
  | CUminus of c_ast
65
64
and c_fcn = Fcn of string * string * (c_decl list) * c_ast
66
65
 
68
67
let ctimes = function
69
68
  | (Integer 1), a -> a
70
69
  | a, (Integer 1) -> a
71
 
  | a, b -> CTimes (a, b)
 
70
  | a, b -> ITimes (a, b)
72
71
 
73
72
(*
74
73
 * C AST unparser 
75
74
 *)
76
75
let foldr_string_concat l = fold_right (^) l ""
77
76
 
78
 
let rec unparse_expr =
 
77
let rec unparse_expr_c =
79
78
  let yes x = x and no x = "" in
80
79
 
81
80
  let rec unparse_plus maybe = 
82
 
    let maybep = maybe " + " and maybem = maybe " - " in
 
81
    let maybep = maybe " + " in
83
82
    function
84
83
    | [] -> ""
85
84
    | (Uminus (Times (a, b))) :: (Uminus c) :: d -> 
99
98
    | c :: (Times (a, b)) :: d -> 
100
99
        maybep ^ (op "FMA" a b c) ^ (unparse_plus yes d)
101
100
    | (Uminus a :: b) -> 
102
 
        maybem ^ (parenthesize a) ^ (unparse_plus yes b)
 
101
        " - " ^ (parenthesize a) ^ (unparse_plus yes b)
103
102
    | (a :: b) -> 
104
103
        maybep ^ (parenthesize a) ^ (unparse_plus yes b)
105
104
  and parenthesize x = match x with
106
 
  | (Load _) -> unparse_expr x
107
 
  | (Num _) -> unparse_expr x
108
 
  | _ -> "(" ^ (unparse_expr x) ^ ")"
 
105
  | (Load _) -> unparse_expr_c x
 
106
  | (Num _) -> unparse_expr_c x
 
107
  | _ -> "(" ^ (unparse_expr_c x) ^ ")"
109
108
  and op nam a b c =
110
 
    nam ^ "(" ^ (unparse_expr a) ^ ", " ^ (unparse_expr b) ^ ", " ^
111
 
    (unparse_expr c) ^ ")"
 
109
    nam ^ "(" ^ (unparse_expr_c a) ^ ", " ^ (unparse_expr_c b) ^ ", " ^
 
110
    (unparse_expr_c c) ^ ")"
112
111
                              
113
112
  in function
114
113
    | Load v -> Variable.unparse v
115
114
    | Num n -> Number.to_konst n
116
115
    | Plus [] -> "0.0 /* bug */"
117
 
    | Plus [a] -> " /* bug */ " ^ (unparse_expr a)
 
116
    | Plus [a] -> " /* bug */ " ^ (unparse_expr_c a)
118
117
    | Plus a -> (unparse_plus no a)
119
118
    | Times (a, b) -> (parenthesize a) ^ " * " ^ (parenthesize b)
 
119
    | Uminus (Plus [a; Uminus b]) -> unparse_plus no [b; Uminus a]
120
120
    | Uminus a -> "- " ^ (parenthesize a)
 
121
    | _ -> failwith "unparse_expr_c"
 
122
 
 
123
and unparse_expr_generic = 
 
124
  let rec u x = unparse_expr_generic x
 
125
  and unary op a = Printf.sprintf "%s(%s)" op (u a)
 
126
  and binary op a b = Printf.sprintf "%s(%s, %s)" op (u a) (u b)
 
127
  and ternary op a b c = Printf.sprintf "%s(%s, %s, %s)" op (u a) (u b) (u c)
 
128
  and quaternary op a b c d = 
 
129
    Printf.sprintf "%s(%s, %s, %s, %s)" op (u a) (u b) (u c) (u d)
 
130
  and unparse_plus = function
 
131
    | [(Uminus (Times (a, b))); Times (c, d)] -> quaternary "FNMMS" a b c d
 
132
    | [Times (c, d); (Uminus (Times (a, b)))] -> quaternary "FNMMS" a b c d
 
133
    | [Times (c, d); (Times (a, b))] -> quaternary "FMMA" a b c d
 
134
    | [(Uminus (Times (a, b))); c] -> ternary "FNMS" a b c
 
135
    | [c; (Uminus (Times (a, b)))] -> ternary "FNMS" a b c
 
136
    | [c; (Times (a, b))] -> ternary "FMA" a b c
 
137
    | [(Times (a, b)); c] -> ternary "FMA" a b c
 
138
    | [a; Uminus b] -> binary "SUB" a b
 
139
    | [a; b] -> binary "ADD" a b
 
140
    | a :: b :: c -> binary "ADD" a (Plus (b :: c))
 
141
    | _ -> failwith "unparse_plus"
 
142
  in function
 
143
    | Load v -> Variable.unparse v 
 
144
    | Num n -> Number.to_konst n
 
145
    | Plus a -> unparse_plus a
 
146
    | Times (a, b) -> binary "MUL" a b
 
147
    | Uminus a -> unary "NEG" a
121
148
    | _ -> failwith "unparse_expr"
122
149
 
 
150
and unparse_expr x = 
 
151
  if !Magic.generic_arith then
 
152
    unparse_expr_generic x
 
153
  else
 
154
    unparse_expr_c x
 
155
 
123
156
and unparse_assignment (Assign (v, x)) =
124
157
  (Variable.unparse v) ^ " = " ^ (unparse_expr x) ^ ";\n"
125
158
 
154
187
 
155
188
and unparse_decl = function
156
189
  | Decl (a, b) -> a ^ " " ^ b ^ ";\n"
157
 
  | Idecl (a, b, c) -> a ^ " " ^ b ^ " = " ^ c ^ ";\n"
158
 
  | Adecl (a, b, n) -> a ^ " " ^ b ^ "[" ^ (string_of_int n) ^ "];\n"
159
 
  | Tdecl x -> x ^ ";\n"
 
190
  | Tdecl x -> x
160
191
 
161
192
and unparse_ast = 
162
193
  let rec unparse_plus = function
165
196
    | (a :: b) -> " + " ^ (parenthesize a) ^ (unparse_plus b)
166
197
  and parenthesize x = match x with
167
198
  | (CVar _) -> unparse_ast x
 
199
  | (CCall _) -> unparse_ast x
168
200
  | (Integer _) -> unparse_ast x
169
201
  | _ -> "(" ^ (unparse_ast x) ^ ")"
170
202
 
193
225
    | Comma (a, b) -> (unparse_ast a) ^ ", " ^ (unparse_ast b)
194
226
    | Integer i -> string_of_int i
195
227
    | CVar s -> s
 
228
    | CCall (s, x) -> s ^ "(" ^ (unparse_ast x) ^ ")"
196
229
    | CPlus [] -> "0 /* bug */"
197
230
    | CPlus [a] -> " /* bug */ " ^ (unparse_ast a)
198
231
    | CPlus (a::b) -> (parenthesize a) ^ (unparse_plus b)
199
 
    | CTimes (a, b) -> (parenthesize a) ^ " * " ^ (parenthesize b)
 
232
    | ITimes (a, b) -> (parenthesize a) ^ " * " ^ (parenthesize b)
200
233
    | CUminus a -> "- " ^ (parenthesize a)
201
234
 
202
235
and unparse_function = function
240
273
 
241
274
let extract_constants f =
242
275
  let constlist = flatten (map expr_to_constants (ast_to_expr_list f))
243
 
  in let u = unique_constants constlist
244
 
  in let use_const () = 
245
 
    map 
246
 
      (fun n ->
247
 
        Idecl (("const " ^ extended_realtype), (Number.to_konst n),
248
 
               "K(" ^ (Number.to_string n) ^ ")"))
249
 
      u
250
 
  and use_compact () = 
251
 
    map
252
 
      (fun n ->
253
 
        Tdecl 
254
 
          ("DK(" ^ (Number.to_konst n) ^ ", " ^ (Number.to_string n) ^ ")"))
255
 
      u
256
 
  in 
257
 
  if !Magic.compact then 
258
 
    use_compact ()
259
 
  else
260
 
    use_const ()
261
 
 
 
276
  in map
 
277
       (fun n ->
 
278
          Tdecl 
 
279
            ("DK(" ^ (Number.to_konst n) ^ ", " ^ (Number.to_string n) ^ 
 
280
               ");\n"))
 
281
       (unique_constants constlist)
 
282
       
262
283
(******************************
263
284
   Extracting operation counts 
264
285
 ******************************)
314
335
 
315
336
let rec count_flops_expr_func (adds, mults, fmas) = function
316
337
  | Plus [] -> (adds, mults, fmas)
317
 
  | Plus ([_; _] as a) -> (match build_fma a with
318
 
    | None ->
319
 
        let (newadds, newmults, newfmas) = 
320
 
          fold_left count_flops_expr_func (adds, mults, fmas) a
321
 
        in (newadds + (length a) - 1, newmults, newfmas)
322
 
    | Some (a, b, c) ->
323
 
        let (newadds, newmults, newfmas) = 
324
 
          fold_left count_flops_expr_func (adds, mults, fmas) [a; b; c]
325
 
        in  (newadds, newmults, newfmas + 1))
 
338
  | Plus ([_; _] as a) -> 
 
339
      begin
 
340
        match build_fma a with
 
341
          | None ->
 
342
              fold_left count_flops_expr_func 
 
343
                (adds + (length a) - 1, mults, fmas) a
 
344
          | Some (a, b, c) ->
 
345
              fold_left count_flops_expr_func (adds, mults, fmas+1) [a; b; c]
 
346
      end
326
347
  | Plus (a :: b) -> 
327
348
      count_flops_expr_func (adds, mults, fmas) (Plus [a; Plus b])
328
 
  | Times (NaN _,b) -> count_flops_expr_func (adds, mults, fmas) b
329
 
  | Times (Num _, b) -> 
330
 
      let (newadds, newmults, newfmas) = 
331
 
        count_flops_expr_func (adds, mults, fmas) b
332
 
      in (newadds, newmults + 1, newfmas)
333
 
  | Times (a,b) ->
334
 
      let (newadds, newmults, newfmas) = 
335
 
        fold_left count_flops_expr_func (adds, mults, fmas) [a; b]
336
 
      in if !Simdmagic.simd_mode then
337
 
        (* complex multiplication *)
338
 
        (newadds + 1, newmults + 2, newfmas)
339
 
      else
340
 
        (newadds, newmults + 1, newfmas)
 
349
  | Times (NaN MULTI_A,_)  -> (adds, mults, fmas)
 
350
  | Times (NaN MULTI_B,_)  -> (adds, mults, fmas)
 
351
  | Times (NaN I,b) -> count_flops_expr_func (adds, mults, fmas) b
 
352
  | Times (a,b) -> fold_left count_flops_expr_func (adds, mults+1, fmas) [a; b]
 
353
  | CTimes (a,b) -> 
 
354
      fold_left count_flops_expr_func (adds+1, mults+2, fmas) [a; b]
 
355
  | CTimesJ (a,b) -> 
 
356
      fold_left count_flops_expr_func (adds+1, mults+2, fmas) [a; b]
341
357
  | Uminus a -> count_flops_expr_func (adds, mults, fmas) a
342
358
  | _ -> (adds, mults, fmas)
343
359
 
352
368
 
353
369
(* print the operation costs *)
354
370
let print_cost f =
355
 
  let Fcn (_, name, _, _) = f 
 
371
  let Fcn (_, _, _, _) = f 
356
372
  and (a, m, fmas, v, mem) = arith_complexity f
357
373
  in
358
374
  "/*\n"^