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