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