Chris@10: (*
Chris@10:  * Copyright (c) 1997-1999 Massachusetts Institute of Technology
Chris@10:  * Copyright (c) 2003, 2007-11 Matteo Frigo
Chris@10:  * Copyright (c) 2003, 2007-11 Massachusetts Institute of Technology
Chris@10:  *
Chris@10:  * This program is free software; you can redistribute it and/or modify
Chris@10:  * it under the terms of the GNU General Public License as published by
Chris@10:  * the Free Software Foundation; either version 2 of the License, or
Chris@10:  * (at your option) any later version.
Chris@10:  *
Chris@10:  * This program is distributed in the hope that it will be useful,
Chris@10:  * but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@10:  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Chris@10:  * GNU General Public License for more details.
Chris@10:  *
Chris@10:  * You should have received a copy of the GNU General Public License
Chris@10:  * along with this program; if not, write to the Free Software
Chris@10:  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
Chris@10:  *
Chris@10:  *)
Chris@10: 
Chris@10: (* utilities common to all generators *)
Chris@10: open Util
Chris@10: 
Chris@10: let choose_simd a b = if !Simdmagic.simd_mode then b else a
Chris@10: 
Chris@10: let unique_array n = array n (fun _ -> Unique.make ())
Chris@10: let unique_array_c n = 
Chris@10:   array n (fun _ -> 
Chris@10:     (Unique.make (), Unique.make ()))
Chris@10: 
Chris@10: let unique_v_array_c veclen n = 
Chris@10:   array veclen (fun _ ->
Chris@10:     unique_array_c n)
Chris@10: 
Chris@10: let locative_array_c n rarr iarr loc vs = 
Chris@10:   array n (fun i -> 
Chris@10:     let klass = Unique.make () in
Chris@10:     let (rloc, iloc) = loc i in
Chris@10:     (Variable.make_locative rloc klass rarr i vs,
Chris@10:      Variable.make_locative iloc klass iarr i vs))
Chris@10: 
Chris@10: let locative_v_array_c veclen n rarr iarr loc vs = 
Chris@10:   array veclen (fun v ->
Chris@10:     array n (fun i -> 
Chris@10:       let klass = Unique.make () in
Chris@10:       let (rloc, iloc) = loc v i in
Chris@10:       (Variable.make_locative rloc klass (rarr v) i vs,
Chris@10:        Variable.make_locative iloc klass (iarr v) i vs)))
Chris@10: 
Chris@10: let temporary_array n = 
Chris@10:   array n (fun i -> Variable.make_temporary ())
Chris@10: 
Chris@10: let temporary_array_c n = 
Chris@10:   let tmpr = temporary_array n
Chris@10:   and tmpi = temporary_array n
Chris@10:   in 
Chris@10:   array n (fun i -> (tmpr i, tmpi i))
Chris@10: 
Chris@10: let temporary_v_array_c veclen n =
Chris@10:   array veclen (fun v -> temporary_array_c n)
Chris@10: 
Chris@10: let temporary_array_c n = 
Chris@10:   let tmpr = temporary_array n
Chris@10:   and tmpi = temporary_array n
Chris@10:   in 
Chris@10:   array n (fun i -> (tmpr i, tmpi i))
Chris@10: 
Chris@10: let load_c (vr, vi) = Complex.make (Expr.Load vr, Expr.Load vi)
Chris@10: let load_r (vr, vi) = Complex.make (Expr.Load vr, Expr.Num (Number.zero))
Chris@10: 
Chris@10: let twiddle_array nt w =
Chris@10:   array (nt/2) (fun i ->
Chris@10:     let stride = choose_simd (C.SInteger 1) (C.SConst "TWVL") 
Chris@10:     and klass = Unique.make () in
Chris@10:     let (refr, refi) = (C.array_subscript w stride (2 * i),
Chris@10: 			C.array_subscript w stride (2 * i + 1))
Chris@10:     in
Chris@10:     let (kr, ki) = (Variable.make_constant klass refr,
Chris@10: 		    Variable.make_constant klass refi)  
Chris@10:     in
Chris@10:     load_c (kr, ki))
Chris@10: 
Chris@10: 
Chris@10: let load_array_c n var = array n (fun i -> load_c (var i))
Chris@10: let load_array_r n var = array n (fun i -> load_r (var i))
Chris@10: let load_array_hc n var = 
Chris@10:   array n (fun i -> 
Chris@10:     if (i < n - i) then
Chris@10:       load_c (var i)
Chris@10:     else if (i > n - i) then
Chris@10:       Complex.times Complex.i (load_c (var (n - i)))
Chris@10:     else
Chris@10:       load_r (var i))
Chris@10: 
Chris@10: let load_v_array_c veclen n var =
Chris@10:   array veclen (fun v -> load_array_c n (var v))
Chris@10: 
Chris@10: let store_c (vr, vi) x = [Complex.store_real vr x; Complex.store_imag vi x]
Chris@10: let store_r (vr, vi) x = Complex.store_real vr x
Chris@10: let store_i (vr, vi) x = Complex.store_imag vi x
Chris@10: 
Chris@10: let assign_array_c n dst src =
Chris@10:   List.flatten
Chris@10:     (rmap (iota n)
Chris@10:        (fun i ->
Chris@10: 	 let (ar, ai) = Complex.assign (dst i) (src i)
Chris@10: 	 in [ar; ai]))
Chris@10: let assign_v_array_c veclen n dst src =
Chris@10:   List.flatten
Chris@10:     (rmap (iota veclen)
Chris@10:        (fun v ->
Chris@10: 	 assign_array_c n (dst v) (src v)))
Chris@10: 
Chris@10: let vassign_v_array_c veclen n dst src =
Chris@10:   List.flatten
Chris@10:     (rmap (iota n) (fun i ->
Chris@10:       List.flatten
Chris@10: 	(rmap (iota veclen)
Chris@10: 	   (fun v ->
Chris@10: 	     let (ar, ai) = Complex.assign (dst v i) (src v i)
Chris@10: 	     in [ar; ai]))))
Chris@10: 
Chris@10: let store_array_r n dst src =
Chris@10:   rmap (iota n)
Chris@10:     (fun i -> store_r (dst i) (src i))
Chris@10: 
Chris@10: let store_array_c n dst src =
Chris@10:   List.flatten
Chris@10:     (rmap (iota n)
Chris@10:        (fun i -> store_c (dst i) (src i)))
Chris@10: 
Chris@10: let store_array_hc n dst src =
Chris@10:   List.flatten
Chris@10:     (rmap (iota n)
Chris@10:        (fun i -> 
Chris@10: 	 if (i < n - i) then
Chris@10: 	   store_c (dst i) (src i)
Chris@10: 	 else if (i > n - i) then
Chris@10: 	   []
Chris@10: 	 else 
Chris@10: 	   [store_r (dst i) (Complex.real (src i))]))
Chris@10: 	
Chris@10: 
Chris@10: let store_v_array_c veclen n dst src =
Chris@10:   List.flatten
Chris@10:     (rmap (iota veclen)
Chris@10:        (fun v ->
Chris@10: 	 store_array_c n (dst v) (src v)))
Chris@10: 
Chris@10: 
Chris@10: let elementwise f n a = array n (fun i -> f (a i))
Chris@10: let conj_array_c = elementwise Complex.conj
Chris@10: let real_array_c = elementwise Complex.real
Chris@10: let imag_array_c = elementwise Complex.imag
Chris@10: 
Chris@10: let elementwise_v f veclen n a = 
Chris@10:   array veclen (fun v ->
Chris@10:     array n (fun i -> f (a v i)))
Chris@10: let conj_v_array_c = elementwise_v Complex.conj
Chris@10: let real_v_array_c = elementwise_v Complex.real
Chris@10: let imag_v_array_c = elementwise_v Complex.imag
Chris@10: 
Chris@10: 
Chris@10: let transpose f i j = f j i
Chris@10: let symmetrize f i j = if i <= j then f i j else f j i
Chris@10: 
Chris@10: (* utilities for command-line parsing *)
Chris@10: let standard_arg_parse_fail _ = failwith "too many arguments"
Chris@10: 
Chris@10: let dump_dag alist =
Chris@10:   let fnam = !Magic.dag_dump_file in
Chris@10:   if (String.length fnam > 0) then
Chris@10:     let ochan = open_out fnam in
Chris@10:     begin
Chris@10:       To_alist.dump (output_string ochan) alist;
Chris@10:       close_out ochan;
Chris@10:     end
Chris@10: 
Chris@10: let dump_alist alist =
Chris@10:   let fnam = !Magic.alist_dump_file in
Chris@10:   if (String.length fnam > 0) then
Chris@10:     let ochan = open_out fnam in
Chris@10:     begin
Chris@10:       Expr.dump (output_string ochan) alist;
Chris@10:       close_out ochan;
Chris@10:     end
Chris@10: 
Chris@10: let dump_asched asched =
Chris@10:   let fnam = !Magic.asched_dump_file in
Chris@10:   if (String.length fnam > 0) then
Chris@10:     let ochan = open_out fnam in
Chris@10:     begin
Chris@10:       Annotate.dump (output_string ochan) asched;
Chris@10:       close_out ochan;
Chris@10:     end
Chris@10: 
Chris@10: (* utilities for optimization *)
Chris@10: let standard_scheduler dag =
Chris@10:   let optim = Algsimp.algsimp dag in
Chris@10:   let alist = To_alist.to_assignments optim in
Chris@10:   let _ = dump_alist alist in
Chris@10:   let _ = dump_dag alist in
Chris@10:     if !Magic.precompute_twiddles then
Chris@10:       Schedule.isolate_precomputations_and_schedule alist 
Chris@10:     else
Chris@10:       Schedule.schedule alist 
Chris@10: 
Chris@10: let standard_optimizer dag =
Chris@10:   let sched = standard_scheduler dag in
Chris@10:   let annot = Annotate.annotate [] sched in
Chris@10:   let _ = dump_asched annot in
Chris@10:   annot
Chris@10: 
Chris@10: let size = ref None
Chris@10: let sign = ref (-1)
Chris@10: 
Chris@10: let speclist = [
Chris@10:   "-n", Arg.Int(fun i -> size := Some i), " generate a codelet of size <n>";
Chris@10:   "-sign",
Chris@10:   Arg.Int(fun i -> 
Chris@10:     if (i > 0) then
Chris@10:       sign := 1
Chris@10:     else
Chris@10:       sign := (-1)),
Chris@10:   " sign of transform";
Chris@10: ]
Chris@10: 
Chris@10: let check_size () =
Chris@10:   match !size with
Chris@10:   | Some i -> i
Chris@10:   | None -> failwith "must specify -n"
Chris@10: 
Chris@10: let expand_name name = if name = "" then "noname" else name
Chris@10: 
Chris@10: let declare_register_fcn name =
Chris@10:   if name = "" then
Chris@10:     "void NAME(planner *p)\n"
Chris@10:   else 
Chris@10:     "void " ^ (choose_simd "X" "XSIMD") ^
Chris@10:       "(codelet_" ^ name ^ ")(planner *p)\n"
Chris@10: 
Chris@10: let stringify name = 
Chris@10:   if name = "" then "STRINGIZE(NAME)" else 
Chris@10:     choose_simd ("\"" ^ name ^ "\"")
Chris@10:       ("XSIMD_STRING(\"" ^ name ^ "\")")
Chris@10: 
Chris@10: let parse user_speclist usage =
Chris@10:   Arg.parse
Chris@10:     (user_speclist @ speclist @ Magic.speclist @ Simdmagic.speclist)
Chris@10:     standard_arg_parse_fail
Chris@10:     usage
Chris@10: 
Chris@10: let rec list_to_c = function
Chris@10:     [] -> ""
Chris@10:   | [a] -> (string_of_int a)
Chris@10:   | a :: b -> (string_of_int a) ^ ", " ^ (list_to_c b)
Chris@10: 
Chris@10: let rec list_to_comma = function
Chris@10:   | [a; b] -> C.Comma (a, b)
Chris@10:   | a :: b -> C.Comma (a, list_to_comma b)
Chris@10:   | _ -> failwith "list_to_comma"
Chris@10: 
Chris@10: 
Chris@10: type stride = Stride_variable | Fixed_int of int | Fixed_string of string
Chris@10: 
Chris@10: let either_stride a b =
Chris@10:   match a with
Chris@10:     Fixed_int x -> C.SInteger x
Chris@10:   | Fixed_string x -> C.SConst x
Chris@10:   | _ -> b
Chris@10: 
Chris@10: let stride_fixed = function
Chris@10:     Stride_variable -> false
Chris@10:   | _ -> true
Chris@10: 
Chris@10: let arg_to_stride s =
Chris@10:   try
Chris@10:     Fixed_int (int_of_string s)
Chris@10:   with Failure "int_of_string" -> 
Chris@10:     Fixed_string s
Chris@10: 
Chris@10: let stride_to_solverparm = function
Chris@10:     Stride_variable -> "0"
Chris@10:   | Fixed_int x -> string_of_int x
Chris@10:   | Fixed_string x -> x
Chris@10: 
Chris@10: let stride_to_string s = function
Chris@10:     Stride_variable -> s
Chris@10:   | Fixed_int x -> string_of_int x
Chris@10:   | Fixed_string x -> x
Chris@10: 
Chris@10: (* output the command line *)
Chris@10: let cmdline () =
Chris@10:   List.fold_right (fun a b -> a ^ " " ^ b) (Array.to_list Sys.argv) ""
Chris@10: 
Chris@10: let unparse tree =
Chris@10:   "/* Generated by: " ^ (cmdline ()) ^ "*/\n\n" ^
Chris@10:   (C.print_cost tree) ^
Chris@10:   (if String.length !Magic.inklude > 0 
Chris@10:   then
Chris@10:     (Printf.sprintf "#include \"%s\"\n\n" !Magic.inklude)
Chris@10:   else "") ^
Chris@10:   (if !Simdmagic.simd_mode then
Chris@10:     Simd.unparse_function tree
Chris@10:   else
Chris@10:     C.unparse_function tree)
Chris@10: 
Chris@10: let finalize_fcn ast = 
Chris@10:   let mergedecls = function
Chris@10:       C.Block (d1, [C.Block (d2, s)]) -> C.Block (d1 @ d2, s)
Chris@10:     | x -> x
Chris@10:   and extract_constants =
Chris@10:     if !Simdmagic.simd_mode then 
Chris@10:       Simd.extract_constants 
Chris@10:     else
Chris@10:       C.extract_constants
Chris@10: 	
Chris@10:   in mergedecls (C.Block (extract_constants ast, [ast; C.Simd_leavefun]))
Chris@10: 
Chris@10: let twinstr_to_string vl x =
Chris@10:   if !Simdmagic.simd_mode then 
Chris@10:     Twiddle.twinstr_to_simd_string vl x
Chris@10:   else
Chris@10:     Twiddle.twinstr_to_c_string x
Chris@10: 
Chris@10: let make_volatile_stride n x = 
Chris@10:   C.CCall ("MAKE_VOLATILE_STRIDE", C.Comma((C.Integer n), x))