summaryrefslogtreecommitdiff
path: root/gcc/config/arm/neon-testgen.ml
blob: 63fbbbf2c35e8e89ea341393f935253476804815 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
(* Auto-generate ARM Neon intrinsics tests.
   Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   Contributed by CodeSourcery.

   This file is part of GCC.

   GCC 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 3, or (at your option) any later
   version.

   GCC 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 GCC; see the file COPYING3.  If not see
   <http://www.gnu.org/licenses/>.

   This is an O'Caml program.  The O'Caml compiler is available from:

     http://caml.inria.fr/

   Or from your favourite OS's friendly packaging system. Tested with version
   3.09.2, though other versions will probably work too.

   Compile with:
     ocamlc -c neon.ml
     ocamlc -o neon-testgen neon.cmo neon-testgen.ml

   Run with:
     cd /path/to/gcc/testsuite/gcc.target/arm/neon
     /path/to/neon-testgen
*)

open Neon

type c_type_flags = Pointer | Const

(* Open a test source file.  *)
let open_test_file dir name =
  try
    open_out (dir ^ "/" ^ name ^ ".c")
  with Sys_error str ->
    failwith ("Could not create test source file " ^ name ^ ": " ^ str)

(* Emit prologue code to a test source file.  *)
let emit_prologue chan test_name =
  Printf.fprintf chan "/* Test the `%s' ARM Neon intrinsic.  */\n" test_name;
  Printf.fprintf chan "/* This file was autogenerated by neon-testgen.  */\n\n";
  Printf.fprintf chan "/* { dg-do assemble } */\n";
  Printf.fprintf chan "/* { dg-require-effective-target arm_neon_ok } */\n";
  Printf.fprintf chan "/* { dg-options \"-save-temps -O0\" } */\n";
  Printf.fprintf chan "/* { dg-add-options arm_neon } */\n";
  Printf.fprintf chan "\n#include \"arm_neon.h\"\n\n";
  Printf.fprintf chan "void test_%s (void)\n{\n" test_name

(* Emit declarations of local variables that are going to be passed
   to an intrinsic, together with one to take a returned value if needed.  *)
let emit_automatics chan c_types features =
  let emit () =
    ignore (
      List.fold_left (fun arg_number -> fun (flags, ty) ->
                        let pointer_bit =
                          if List.mem Pointer flags then "*" else ""
                        in
                          (* Const arguments to builtins are directly
                             written in as constants.  *)
                          if not (List.mem Const flags) then
                            Printf.fprintf chan "  %s %sarg%d_%s;\n"
                                           ty pointer_bit arg_number ty;
                        arg_number + 1)
                     0 (List.tl c_types))
  in
    match c_types with
      (_, return_ty) :: tys ->
        if return_ty <> "void" then begin
          (* The intrinsic returns a value.  We need to do explict register
             allocation for vget_low tests or they fail because of copy
             elimination.  *)
          ((if List.mem Fixed_return_reg features then
              Printf.fprintf chan "  register %s out_%s asm (\"d18\");\n"
                             return_ty return_ty
            else
              Printf.fprintf chan "  %s out_%s;\n" return_ty return_ty);
	   emit ())
        end else
          (* The intrinsic does not return a value.  *)
          emit ()
    | _ -> assert false

(* Emit code to call an intrinsic.  *)
let emit_call chan const_valuator c_types name elt_ty =
  (if snd (List.hd c_types) <> "void" then
     Printf.fprintf chan "  out_%s = " (snd (List.hd c_types))
   else
     Printf.fprintf chan "  ");
  Printf.fprintf chan "%s_%s (" (intrinsic_name name) (string_of_elt elt_ty);
  let print_arg chan arg_number (flags, ty) =
    (* If the argument is of const type, then directly write in the
       constant now.  *)
    if List.mem Const flags then
      match const_valuator with
        None ->
          if List.mem Pointer flags then
            Printf.fprintf chan "0"
          else
            Printf.fprintf chan "1"
      | Some f -> Printf.fprintf chan "%s" (string_of_int (f arg_number))
    else
      Printf.fprintf chan "arg%d_%s" arg_number ty
  in
  let rec print_args arg_number tys =
    match tys with
      [] -> ()
    | [ty] -> print_arg chan arg_number ty
    | ty::tys ->
      print_arg chan arg_number ty;
      Printf.fprintf chan ", ";
      print_args (arg_number + 1) tys
  in
    print_args 0 (List.tl c_types);
    Printf.fprintf chan ");\n"

(* Emit epilogue code to a test source file.  *)
let emit_epilogue chan features regexps =
  let no_op = List.exists (fun feature -> feature = No_op) features in
    Printf.fprintf chan "}\n\n";
    (if not no_op then
       List.iter (fun regexp ->
                   Printf.fprintf chan
                     "/* { dg-final { scan-assembler \"%s\" } } */\n" regexp)
                regexps
     else
       ()
    );
    Printf.fprintf chan "/* { dg-final { cleanup-saved-temps } } */\n"

(* Check a list of C types to determine which ones are pointers and which
   ones are const.  *)
let check_types tys =
  let tys' =
    List.map (fun ty ->
                let len = String.length ty in
                  if len > 2 && String.get ty (len - 2) = ' '
                             && String.get ty (len - 1) = '*'
                  then ([Pointer], String.sub ty 0 (len - 2))
                  else ([], ty)) tys
  in
    List.map (fun (flags, ty) ->
                if String.length ty > 6 && String.sub ty 0 6 = "const "
                then (Const :: flags, String.sub ty 6 ((String.length ty) - 6))
                else (flags, ty)) tys'

(* Given an intrinsic shape, produce a regexp that will match
   the right-hand sides of instructions generated by an intrinsic of
   that shape.  *)
let rec analyze_shape shape =
  let rec n_things n thing =
    match n with
      0 -> []
    | n -> thing :: (n_things (n - 1) thing)
  in
  let rec analyze_shape_elt elt =
    match elt with
      Dreg -> "\\[dD\\]\\[0-9\\]+"
    | Qreg -> "\\[qQ\\]\\[0-9\\]+"
    | Corereg -> "\\[rR\\]\\[0-9\\]+"
    | Immed -> "#\\[0-9\\]+"
    | VecArray (1, elt) ->
        let elt_regexp = analyze_shape_elt elt in
          "((\\\\\\{" ^ elt_regexp ^ "\\\\\\})|(" ^ elt_regexp ^ "))"
    | VecArray (n, elt) ->
      let elt_regexp = analyze_shape_elt elt in
      let alt1 = elt_regexp ^ "-" ^ elt_regexp in
      let alt2 = commas (fun x -> x) (n_things n elt_regexp) "" in
        "\\\\\\{((" ^ alt1 ^ ")|(" ^ alt2 ^ "))\\\\\\}"
    | (PtrTo elt | CstPtrTo elt) ->
      "\\\\\\[" ^ (analyze_shape_elt elt) ^ "\\\\\\]"
    | Element_of_dreg -> (analyze_shape_elt Dreg) ^ "\\\\\\[\\[0-9\\]+\\\\\\]"
    | Element_of_qreg -> (analyze_shape_elt Qreg) ^ "\\\\\\[\\[0-9\\]+\\\\\\]"
    | All_elements_of_dreg -> (analyze_shape_elt Dreg) ^ "\\\\\\[\\\\\\]"
    | Alternatives (elts) -> "(" ^ (String.concat "|" (List.map analyze_shape_elt elts)) ^ ")"
  in
    match shape with
      All (n, elt) -> commas analyze_shape_elt (n_things n elt) ""
    | Long -> (analyze_shape_elt Qreg) ^ ", " ^ (analyze_shape_elt Dreg) ^
              ", " ^ (analyze_shape_elt Dreg)
    | Long_noreg elt -> (analyze_shape_elt elt) ^ ", " ^ (analyze_shape_elt elt)
    | Wide -> (analyze_shape_elt Qreg) ^ ", " ^ (analyze_shape_elt Qreg) ^
              ", " ^ (analyze_shape_elt Dreg)
    | Wide_noreg elt -> analyze_shape (Long_noreg elt)
    | Narrow -> (analyze_shape_elt Dreg) ^ ", " ^ (analyze_shape_elt Qreg) ^
                ", " ^ (analyze_shape_elt Qreg)
    | Use_operands elts -> commas analyze_shape_elt (Array.to_list elts) ""
    | By_scalar Dreg ->
        analyze_shape (Use_operands [| Dreg; Dreg; Element_of_dreg |])
    | By_scalar Qreg ->
        analyze_shape (Use_operands [| Qreg; Qreg; Element_of_dreg |])
    | By_scalar _ -> assert false
    | Wide_lane ->
        analyze_shape (Use_operands [| Qreg; Dreg; Element_of_dreg |])
    | Wide_scalar ->
        analyze_shape (Use_operands [| Qreg; Dreg; Element_of_dreg |])
    | Pair_result elt ->
      let elt_regexp = analyze_shape_elt elt in
        elt_regexp ^ ", " ^ elt_regexp
    | Unary_scalar _ -> "FIXME Unary_scalar"
    | Binary_imm elt -> analyze_shape (Use_operands [| elt; elt; Immed |])
    | Narrow_imm -> analyze_shape (Use_operands [| Dreg; Qreg; Immed |])
    | Long_imm -> analyze_shape (Use_operands [| Qreg; Dreg; Immed |])

(* Generate tests for one intrinsic.  *)
let test_intrinsic dir opcode features shape name munge elt_ty =
  (* Open the test source file.  *)
  let test_name = name ^ (string_of_elt elt_ty) in
  let chan = open_test_file dir test_name in
  (* Work out what argument and return types the intrinsic has.  *)
  let c_arity, new_elt_ty = munge shape elt_ty in
  let c_types = check_types (strings_of_arity c_arity) in
  (* Extract any constant valuator (a function specifying what constant
     values are to be written into the intrinsic call) from the features
     list.  *)
  let const_valuator =
    try
      match (List.find (fun feature -> match feature with
                                         Const_valuator _ -> true
				       | _ -> false) features) with
        Const_valuator f -> Some f
      | _ -> assert false
    with Not_found -> None
  in
  (* Work out what instruction name(s) to expect.  *)
  let insns = get_insn_names features name in
  let no_suffix = (new_elt_ty = NoElts) in
  let insns =
    if no_suffix then insns
                 else List.map (fun insn ->
                                  let suffix = string_of_elt_dots new_elt_ty in
                                    insn ^ "\\." ^ suffix) insns
  in
  (* Construct a regexp to match against the expected instruction name(s).  *)
  let insn_regexp =
    match insns with
      [] -> assert false
    | [insn] -> insn
    | _ ->
      let rec calc_regexp insns cur_regexp =
        match insns with
          [] -> cur_regexp
        | [insn] -> cur_regexp ^ "(" ^ insn ^ "))"
        | insn::insns -> calc_regexp insns (cur_regexp ^ "(" ^ insn ^ ")|")
      in calc_regexp insns "("
  in
  (* Construct regexps to match against the instructions that this
     intrinsic expands to.  Watch out for any writeback character and
     comments after the instruction.  *)
  let regexps = List.map (fun regexp -> insn_regexp ^ "\\[ \t\\]+" ^ regexp ^
			  "!?\\(\\[ \t\\]+@\\[a-zA-Z0-9 \\]+\\)?\\n")
                         (analyze_all_shapes features shape analyze_shape)
  in
    (* Emit file and function prologues.  *)
    emit_prologue chan test_name;
    (* Emit local variable declarations.  *)
    emit_automatics chan c_types features;
    Printf.fprintf chan "\n";
    (* Emit the call to the intrinsic.  *)
    emit_call chan const_valuator c_types name elt_ty;
    (* Emit the function epilogue and the DejaGNU scan-assembler directives.  *)
    emit_epilogue chan features regexps;
    (* Close the test file.  *)
    close_out chan

(* Generate tests for one element of the "ops" table.  *)
let test_intrinsic_group dir (opcode, features, shape, name, munge, types) =
  List.iter (test_intrinsic dir opcode features shape name munge) types

(* Program entry point.  *)
let _ =
  let directory = if Array.length Sys.argv <> 1 then Sys.argv.(1) else "." in
    List.iter (test_intrinsic_group directory) (reinterp @ ops)