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