X-Git-Url: https://oss.titaniummirror.com/gitweb/?a=blobdiff_plain;f=gcc%2Fconfig%2Farm%2Fneon-testgen.ml;fp=gcc%2Fconfig%2Farm%2Fneon-testgen.ml;h=00a8e5332f49e073149a11b04b0c482c649bcef3;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=0000000000000000000000000000000000000000;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/config/arm/neon-testgen.ml b/gcc/config/arm/neon-testgen.ml new file mode 100644 index 00000000..00a8e533 --- /dev/null +++ b/gcc/config/arm/neon-testgen.ml @@ -0,0 +1,276 @@ +(* Auto-generate ARM Neon intrinsics tests. + Copyright (C) 2006, 2007 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 + . + + 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 -mfpu=neon -mfloat-abi=softfp\" } */\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 = + 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 + (* The intrinsic returns a value. *) + (Printf.fprintf chan " %s out_%s;\n" return_ty return_ty; + emit ()) + 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) ^ "\\\\\\[\\\\\\]" + 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; + 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) +