From: Olivier Hainque Date: Mon, 21 Apr 2008 09:20:29 +0000 (+0000) Subject: Access to most C builtins from Ada X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=009890be6c6e3f34630be0f086303d42c6aa867b;p=gcc.git Access to most C builtins from Ada 2008-04-21 Olivier Hainque ada/ Access to most C builtins from Ada * utils.c: #include "langhooks.h" and define GCC_DIAG_STYLE. (handle_pure_attribute, handle_novops_attribute, handle_nonnull_attribute, handle_sentinel_attribute, handle_noreturn_attribute, handle_malloc_attribute, handle_type_generic_attribute): New attribute handlers, from C fe. (gnat_internal_attribute_table): Map the new handlers. (gnat_init_decl_processing): Move call to gnat_install_builtins to ... (init_gigi_decls): ... here. (handle_const_attribute, handle_nothrow_attribute, builtin_decl_for): Move to a section dedicated to builtins processing. (build_void_list_node, builtin_type_for_size): New functions. (def_fn_type, get_nonnull_operand): Likewise. (install_builtin_elementary_type, install_builtin_function_types, install_builtin_attributes): Likewise. (fake_attribute_handler): Fake handler for attributes we don't support in Ada. (def_builtin_1): New function, worker for DEF_BUILTIN. (install_builtin_functions): New function. (gnat_install_builtins): Move to the builtins processing section. Now calling the newly introduced installers. testsuite/ * gnat.dg/bltins.adb: New testcase. From-SVN: r134504 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9b825f6ad37..79f8440982c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2008-04-21 Olivier Hainque + + Access to most C builtins from Ada + * utils.c: #include "langhooks.h" and define GCC_DIAG_STYLE. + (handle_pure_attribute, handle_novops_attribute, + handle_nonnull_attribute, handle_sentinel_attribute, + handle_noreturn_attribute, handle_malloc_attribute, + handle_type_generic_attribute): New attribute handlers, from C fe. + (gnat_internal_attribute_table): Map the new handlers. + (gnat_init_decl_processing): Move call to gnat_install_builtins to ... + (init_gigi_decls): ... here. + (handle_const_attribute, handle_nothrow_attribute, builtin_decl_for): + Move to a section dedicated to builtins processing. + (build_void_list_node, builtin_type_for_size): New functions. + (def_fn_type, get_nonnull_operand): Likewise. + (install_builtin_elementary_type, install_builtin_function_types, + install_builtin_attributes): Likewise. + (fake_attribute_handler): Fake handler for attributes we don't + support in Ada. + (def_builtin_1): New function, worker for DEF_BUILTIN. + (install_builtin_functions): New function. + (gnat_install_builtins): Move to the builtins processing section. + Now calling the newly introduced installers. + 2008-04-20 Eric Botcazou * decl.c (gnat_to_gnu_entity) : Also promote the alignment of diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index 94c293f5d5b..498904136cc 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -1125,10 +1125,10 @@ ada/trans.o : ada/trans.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ $(ADA_TREE_H) ada/gigi.h gt-ada-trans.h ada/utils.o : ada/utils.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ - $(TREE_H) $(FLAGS_H) $(EXPR_H) convert.h defaults.h ada/ada.h ada/types.h \ - ada/atree.h ada/nlists.h ada/elists.h ada/sinfo.h ada/einfo.h ada/namet.h \ - ada/stringt.h ada/uintp.h ada/fe.h $(ADA_TREE_H) ada/gigi.h gt-ada-utils.h \ - gtype-ada.h $(TARGET_H) + $(TREE_H) $(FLAGS_H) $(EXPR_H) convert.h defaults.h langhooks.h \ + ada/ada.h ada/types.h ada/atree.h ada/nlists.h ada/elists.h ada/sinfo.h \ + ada/einfo.h ada/namet.h ada/stringt.h ada/uintp.h ada/fe.h $(ADA_TREE_H) \ + ada/gigi.h gt-ada-utils.h gtype-ada.h $(TARGET_H) ada/utils2.o : ada/utils2.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ $(TREE_H) $(FLAGS_H) ada/ada.h ada/types.h ada/atree.h ada/nlists.h \ diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index e3867fa6912..d6a2234e747 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -23,6 +23,10 @@ * * ****************************************************************************/ +/* We have attribute handlers using C specific format specifiers in warning + messages. Make sure they are properly recognized. */ +#define GCC_DIAG_STYLE __gcc_cdiag__ + #include "config.h" #include "system.h" #include "coretypes.h" @@ -42,6 +46,7 @@ #include "tree-gimple.h" #include "tree-dump.h" #include "pointer-set.h" +#include "langhooks.h" #include "ada.h" #include "types.h" @@ -77,16 +82,40 @@ tree gnat_raise_decls[(int) LAST_REASON_CODE + 1]; /* Forward declarations for handlers of attributes. */ static tree handle_const_attribute (tree *, tree, tree, int, bool *); static tree handle_nothrow_attribute (tree *, tree, tree, int, bool *); +static tree handle_pure_attribute (tree *, tree, tree, int, bool *); +static tree handle_novops_attribute (tree *, tree, tree, int, bool *); +static tree handle_nonnull_attribute (tree *, tree, tree, int, bool *); +static tree handle_sentinel_attribute (tree *, tree, tree, int, bool *); +static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *); +static tree handle_malloc_attribute (tree *, tree, tree, int, bool *); +static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *); + +/* Fake handler for attributes we don't properly support, typically because + they'd require dragging a lot of the common-c front-end circuitry. */ +static tree fake_attribute_handler (tree *, tree, tree, int, bool *); /* Table of machine-independent internal attributes for Ada. We support - this minimal set of attributes to accommodate the Alpha back-end which - unconditionally puts them on its builtins. */ + this minimal set ot attributes to accomodate the needs of builtins. */ const struct attribute_spec gnat_internal_attribute_table[] = { /* { name, min_len, max_len, decl_req, type_req, fn_type_req, handler } */ - { "const", 0, 0, true, false, false, handle_const_attribute }, - { "nothrow", 0, 0, true, false, false, handle_nothrow_attribute }, - { NULL, 0, 0, false, false, false, NULL } + { "const", 0, 0, true, false, false, handle_const_attribute }, + { "nothrow", 0, 0, true, false, false, handle_nothrow_attribute }, + { "pure", 0, 0, true, false, false, handle_pure_attribute }, + { "no vops", 0, 0, true, false, false, handle_novops_attribute }, + { "nonnull", 0, -1, false, true, true, handle_nonnull_attribute }, + { "sentinel", 0, 1, false, true, true, handle_sentinel_attribute }, + { "noreturn", 0, 0, true, false, false, handle_noreturn_attribute }, + { "malloc", 0, 0, true, false, false, handle_malloc_attribute }, + { "type generic", 0, 0, false, true, true, handle_type_generic_attribute }, + + /* ??? format and format_arg are heavy and not supported, which actually + prevents support for stdio builtins, which we however declare as part + of the common builtins.def contents. */ + { "format", 3, 3, false, true, true, fake_attribute_handler }, + { "format_arg", 1, 1, false, true, true, fake_attribute_handler }, + + { NULL, 0, 0, false, false, false, NULL } }; /* Associates a GNAT tree node to a GCC tree node. It is used in @@ -149,7 +178,7 @@ static GTY((deletable)) struct gnat_binding_level *free_binding_level; /* An array of global declarations. */ static GTY(()) VEC(tree,gc) *global_decls; -/* An array of builtin declarations. */ +/* An array of builtin function declarations. */ static GTY(()) VEC(tree,gc) *builtin_decls; /* An array of global renaming pointers. */ @@ -494,20 +523,6 @@ gnat_init_decl_processing (void) build_common_tree_nodes_2 (0); ptr_void_type_node = build_pointer_type (void_type_node); - - gnat_install_builtins (); -} - -/* Install the builtin functions we might need. */ - -static void -gnat_install_builtins () -{ - /* Builtins used by generic middle-end optimizers. */ - build_common_builtin_nodes (); - - /* Target specific builtins, such as the AltiVec family on ppc. */ - targetm.init_builtins (); } /* Create the predefined scalar types such as `integer_type_node' needed @@ -761,6 +776,10 @@ init_gigi_decls (tree long_long_float_type, tree exception_type) DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF; main_identifier_node = get_identifier ("main"); + + /* Install the builtins we might need, either internally or as + user available facilities for Intrinsic imports. */ + gnat_install_builtins (); } /* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST, @@ -2225,38 +2244,6 @@ gnat_builtin_function (tree decl) return decl; } -/* Handle a "const" attribute; arguments as in - struct attribute_spec.handler. */ - -static tree -handle_const_attribute (tree *node, tree ARG_UNUSED (name), - tree ARG_UNUSED (args), int ARG_UNUSED (flags), - bool *no_add_attrs) -{ - if (TREE_CODE (*node) == FUNCTION_DECL) - TREE_READONLY (*node) = 1; - else - *no_add_attrs = true; - - return NULL_TREE; -} - -/* Handle a "nothrow" attribute; arguments as in - struct attribute_spec.handler. */ - -static tree -handle_nothrow_attribute (tree *node, tree ARG_UNUSED (name), - tree ARG_UNUSED (args), int ARG_UNUSED (flags), - bool *no_add_attrs) -{ - if (TREE_CODE (*node) == FUNCTION_DECL) - TREE_NOTHROW (*node) = 1; - else - *no_add_attrs = true; - - return NULL_TREE; -} - /* Return an integer type with the number of bits of precision given by PRECISION. UNSIGNEDP is nonzero if the type is unsigned; otherwise it is a signed type. */ @@ -4039,22 +4026,6 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) return expr; } -/* Search the chain of currently available builtin declarations for a node - corresponding to function NAME (an IDENTIFIER_NODE). Return the first node - found, if any, or NULL_TREE otherwise. */ -tree -builtin_decl_for (tree name) -{ - unsigned i; - tree decl; - - for (i = 0; VEC_iterate(tree, builtin_decls, i, decl); i++) - if (DECL_NAME (decl) == name) - return decl; - - return NULL_TREE; -} - /* Return the appropriate GCC tree code for the specified GNAT type, the latter being a record type as predicated by Is_Record_Type. */ @@ -4129,5 +4100,675 @@ gnat_write_global_declarations (void) VEC_length (tree, global_decls)); } +/* ************************************************************************ + * * GCC builtins support * + * ************************************************************************ */ + +/* The general scheme is fairly simple: + + For each builtin function/type to be declared, gnat_install_builtins calls + internal facilities which eventually get to gnat_push_decl, which in turn + tracks the so declared builtin function decls in the 'builtin_decls' global + datastructure. When an Intrinsic subprogram declaration is processed, we + search this global datastructure to retrieve the associated BUILT_IN DECL + node. */ + +/* Search the chain of currently available builtin declarations for a node + corresponding to function NAME (an IDENTIFIER_NODE). Return the first node + found, if any, or NULL_TREE otherwise. */ +tree +builtin_decl_for (tree name) +{ + unsigned i; + tree decl; + + for (i = 0; VEC_iterate(tree, builtin_decls, i, decl); i++) + if (DECL_NAME (decl) == name) + return decl; + + return NULL_TREE; +} + +/* The code below eventually exposes gnat_install_builtins, which declares + the builtin types and functions we might need, either internally or as + user accessible facilities. + + ??? This is a first implementation shot, still in rough shape. It is + heavily inspired from the "C" family implementation, with chunks copied + verbatim from there. + + Two obvious TODO candidates are + o Use a more efficient name/decl mapping scheme + o Devise a middle-end infrastructure to avoid having to copy + pieces between front-ends. */ + +/* ----------------------------------------------------------------------- * + * BUILTIN ELEMENTARY TYPES * + * ----------------------------------------------------------------------- */ + +/* Standard data types to be used in builtin argument declarations. */ + +enum c_tree_index +{ + CTI_SIGNED_SIZE_TYPE, /* For format checking only. */ + CTI_STRING_TYPE, + CTI_CONST_STRING_TYPE, + + CTI_MAX +}; + +static tree c_global_trees[CTI_MAX]; + +#define signed_size_type_node c_global_trees[CTI_SIGNED_SIZE_TYPE] +#define string_type_node c_global_trees[CTI_STRING_TYPE] +#define const_string_type_node c_global_trees[CTI_CONST_STRING_TYPE] + +/* ??? In addition some attribute handlers, we currently don't support a + (small) number of builtin-types, which in turns inhibits support for a + number of builtin functions. */ +#define wint_type_node void_type_node +#define intmax_type_node void_type_node +#define uintmax_type_node void_type_node + +/* Build the void_list_node (void_type_node having been created). */ + +static tree +build_void_list_node (void) +{ + tree t = build_tree_list (NULL_TREE, void_type_node); + return t; +} + +/* Used to help initialize the builtin-types.def table. When a type of + the correct size doesn't exist, use error_mark_node instead of NULL. + The later results in segfaults even when a decl using the type doesn't + get invoked. */ + +static tree +builtin_type_for_size (int size, bool unsignedp) +{ + tree type = lang_hooks.types.type_for_size (size, unsignedp); + return type ? type : error_mark_node; +} + +/* Build/push the elementary type decls that builtin functions/types + will need. */ + +static void +install_builtin_elementary_types (void) +{ + signed_size_type_node = size_type_node; + pid_type_node = integer_type_node; + void_list_node = build_void_list_node (); + + string_type_node = build_pointer_type (char_type_node); + const_string_type_node + = build_pointer_type (build_qualified_type + (char_type_node, TYPE_QUAL_CONST)); +} + +/* ----------------------------------------------------------------------- * + * BUILTIN FUNCTION TYPES * + * ----------------------------------------------------------------------- */ + +/* Now, builtin function types per se. */ + +enum c_builtin_type +{ +#define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME, +#define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME, +#define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME, +#define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME, +#define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME, +#define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME, +#define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME, +#define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME, +#define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME, +#define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME, +#define DEF_FUNCTION_TYPE_VAR_1(NAME, RETURN, ARG1) NAME, +#define DEF_FUNCTION_TYPE_VAR_2(NAME, RETURN, ARG1, ARG2) NAME, +#define DEF_FUNCTION_TYPE_VAR_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME, +#define DEF_FUNCTION_TYPE_VAR_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME, +#define DEF_FUNCTION_TYPE_VAR_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG6) \ + NAME, +#define DEF_POINTER_TYPE(NAME, TYPE) NAME, +#include "builtin-types.def" +#undef DEF_PRIMITIVE_TYPE +#undef DEF_FUNCTION_TYPE_0 +#undef DEF_FUNCTION_TYPE_1 +#undef DEF_FUNCTION_TYPE_2 +#undef DEF_FUNCTION_TYPE_3 +#undef DEF_FUNCTION_TYPE_4 +#undef DEF_FUNCTION_TYPE_5 +#undef DEF_FUNCTION_TYPE_6 +#undef DEF_FUNCTION_TYPE_7 +#undef DEF_FUNCTION_TYPE_VAR_0 +#undef DEF_FUNCTION_TYPE_VAR_1 +#undef DEF_FUNCTION_TYPE_VAR_2 +#undef DEF_FUNCTION_TYPE_VAR_3 +#undef DEF_FUNCTION_TYPE_VAR_4 +#undef DEF_FUNCTION_TYPE_VAR_5 +#undef DEF_POINTER_TYPE + BT_LAST +}; + +typedef enum c_builtin_type builtin_type; + +/* A temporary array used in communication with def_fn_type. */ +static GTY(()) tree builtin_types[(int) BT_LAST + 1]; + +/* A helper function for install_builtin_types. Build function type + for DEF with return type RET and N arguments. If VAR is true, then the + function should be variadic after those N arguments. + + Takes special care not to ICE if any of the types involved are + error_mark_node, which indicates that said type is not in fact available + (see builtin_type_for_size). In which case the function type as a whole + should be error_mark_node. */ + +static void +def_fn_type (builtin_type def, builtin_type ret, bool var, int n, ...) +{ + tree args = NULL, t; + va_list list; + int i; + + va_start (list, n); + for (i = 0; i < n; ++i) + { + builtin_type a = va_arg (list, builtin_type); + t = builtin_types[a]; + if (t == error_mark_node) + goto egress; + args = tree_cons (NULL_TREE, t, args); + } + va_end (list); + + args = nreverse (args); + if (!var) + args = chainon (args, void_list_node); + + t = builtin_types[ret]; + if (t == error_mark_node) + goto egress; + t = build_function_type (t, args); + + egress: + builtin_types[def] = t; +} + +/* Build the builtin function types and install them in the builtin_types + array for later use in builtin function decls. */ + +static void +install_builtin_function_types (void) +{ + tree va_list_ref_type_node; + tree va_list_arg_type_node; + + if (TREE_CODE (va_list_type_node) == ARRAY_TYPE) + { + va_list_arg_type_node = va_list_ref_type_node = + build_pointer_type (TREE_TYPE (va_list_type_node)); + } + else + { + va_list_arg_type_node = va_list_type_node; + va_list_ref_type_node = build_reference_type (va_list_type_node); + } + +#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \ + builtin_types[ENUM] = VALUE; +#define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \ + def_fn_type (ENUM, RETURN, 0, 0); +#define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \ + def_fn_type (ENUM, RETURN, 0, 1, ARG1); +#define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \ + def_fn_type (ENUM, RETURN, 0, 2, ARG1, ARG2); +#define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \ + def_fn_type (ENUM, RETURN, 0, 3, ARG1, ARG2, ARG3); +#define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \ + def_fn_type (ENUM, RETURN, 0, 4, ARG1, ARG2, ARG3, ARG4); +#define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \ + def_fn_type (ENUM, RETURN, 0, 5, ARG1, ARG2, ARG3, ARG4, ARG5); +#define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \ + ARG6) \ + def_fn_type (ENUM, RETURN, 0, 6, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6); +#define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \ + ARG6, ARG7) \ + def_fn_type (ENUM, RETURN, 0, 7, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7); +#define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \ + def_fn_type (ENUM, RETURN, 1, 0); +#define DEF_FUNCTION_TYPE_VAR_1(ENUM, RETURN, ARG1) \ + def_fn_type (ENUM, RETURN, 1, 1, ARG1); +#define DEF_FUNCTION_TYPE_VAR_2(ENUM, RETURN, ARG1, ARG2) \ + def_fn_type (ENUM, RETURN, 1, 2, ARG1, ARG2); +#define DEF_FUNCTION_TYPE_VAR_3(ENUM, RETURN, ARG1, ARG2, ARG3) \ + def_fn_type (ENUM, RETURN, 1, 3, ARG1, ARG2, ARG3); +#define DEF_FUNCTION_TYPE_VAR_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \ + def_fn_type (ENUM, RETURN, 1, 4, ARG1, ARG2, ARG3, ARG4); +#define DEF_FUNCTION_TYPE_VAR_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \ + def_fn_type (ENUM, RETURN, 1, 5, ARG1, ARG2, ARG3, ARG4, ARG5); +#define DEF_POINTER_TYPE(ENUM, TYPE) \ + builtin_types[(int) ENUM] = build_pointer_type (builtin_types[(int) TYPE]); + +#include "builtin-types.def" + +#undef DEF_PRIMITIVE_TYPE +#undef DEF_FUNCTION_TYPE_1 +#undef DEF_FUNCTION_TYPE_2 +#undef DEF_FUNCTION_TYPE_3 +#undef DEF_FUNCTION_TYPE_4 +#undef DEF_FUNCTION_TYPE_5 +#undef DEF_FUNCTION_TYPE_6 +#undef DEF_FUNCTION_TYPE_VAR_0 +#undef DEF_FUNCTION_TYPE_VAR_1 +#undef DEF_FUNCTION_TYPE_VAR_2 +#undef DEF_FUNCTION_TYPE_VAR_3 +#undef DEF_FUNCTION_TYPE_VAR_4 +#undef DEF_FUNCTION_TYPE_VAR_5 +#undef DEF_POINTER_TYPE + builtin_types[(int) BT_LAST] = NULL_TREE; +} + +/* ----------------------------------------------------------------------- * + * BUILTIN ATTRIBUTES * + * ----------------------------------------------------------------------- */ + +enum built_in_attribute +{ +#define DEF_ATTR_NULL_TREE(ENUM) ENUM, +#define DEF_ATTR_INT(ENUM, VALUE) ENUM, +#define DEF_ATTR_IDENT(ENUM, STRING) ENUM, +#define DEF_ATTR_TREE_LIST(ENUM, PURPOSE, VALUE, CHAIN) ENUM, +#include "builtin-attrs.def" +#undef DEF_ATTR_NULL_TREE +#undef DEF_ATTR_INT +#undef DEF_ATTR_IDENT +#undef DEF_ATTR_TREE_LIST + ATTR_LAST +}; + +static GTY(()) tree built_in_attributes[(int) ATTR_LAST]; + +static void +install_builtin_attributes (void) +{ + /* Fill in the built_in_attributes array. */ +#define DEF_ATTR_NULL_TREE(ENUM) \ + built_in_attributes[(int) ENUM] = NULL_TREE; +#define DEF_ATTR_INT(ENUM, VALUE) \ + built_in_attributes[(int) ENUM] = build_int_cst (NULL_TREE, VALUE); +#define DEF_ATTR_IDENT(ENUM, STRING) \ + built_in_attributes[(int) ENUM] = get_identifier (STRING); +#define DEF_ATTR_TREE_LIST(ENUM, PURPOSE, VALUE, CHAIN) \ + built_in_attributes[(int) ENUM] \ + = tree_cons (built_in_attributes[(int) PURPOSE], \ + built_in_attributes[(int) VALUE], \ + built_in_attributes[(int) CHAIN]); +#include "builtin-attrs.def" +#undef DEF_ATTR_NULL_TREE +#undef DEF_ATTR_INT +#undef DEF_ATTR_IDENT +#undef DEF_ATTR_TREE_LIST +} + +/* Handle a "const" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_const_attribute (tree *node, tree ARG_UNUSED (name), + tree ARG_UNUSED (args), int ARG_UNUSED (flags), + bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL) + TREE_READONLY (*node) = 1; + else + *no_add_attrs = true; + + return NULL_TREE; +} + +/* Handle a "nothrow" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_nothrow_attribute (tree *node, tree ARG_UNUSED (name), + tree ARG_UNUSED (args), int ARG_UNUSED (flags), + bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL) + TREE_NOTHROW (*node) = 1; + else + *no_add_attrs = true; + + return NULL_TREE; +} + +/* Handle a "pure" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_pure_attribute (tree *node, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL) + DECL_IS_PURE (*node) = 1; + /* ??? TODO: Support types. */ + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Handle a "no vops" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_novops_attribute (tree *node, tree ARG_UNUSED (name), + tree ARG_UNUSED (args), int ARG_UNUSED (flags), + bool *ARG_UNUSED (no_add_attrs)) +{ + gcc_assert (TREE_CODE (*node) == FUNCTION_DECL); + DECL_IS_NOVOPS (*node) = 1; + return NULL_TREE; +} + +/* Helper for nonnull attribute handling; fetch the operand number + from the attribute argument list. */ + +static bool +get_nonnull_operand (tree arg_num_expr, unsigned HOST_WIDE_INT *valp) +{ + /* Verify the arg number is a constant. */ + if (TREE_CODE (arg_num_expr) != INTEGER_CST + || TREE_INT_CST_HIGH (arg_num_expr) != 0) + return false; + + *valp = TREE_INT_CST_LOW (arg_num_expr); + return true; +} + +/* Handle the "nonnull" attribute. */ +static tree +handle_nonnull_attribute (tree *node, tree ARG_UNUSED (name), + tree args, int ARG_UNUSED (flags), + bool *no_add_attrs) +{ + tree type = *node; + unsigned HOST_WIDE_INT attr_arg_num; + + /* If no arguments are specified, all pointer arguments should be + non-null. Verify a full prototype is given so that the arguments + will have the correct types when we actually check them later. */ + if (!args) + { + if (!TYPE_ARG_TYPES (type)) + { + error ("nonnull attribute without arguments on a non-prototype"); + *no_add_attrs = true; + } + return NULL_TREE; + } + + /* Argument list specified. Verify that each argument number references + a pointer argument. */ + for (attr_arg_num = 1; args; args = TREE_CHAIN (args)) + { + tree argument; + unsigned HOST_WIDE_INT arg_num = 0, ck_num; + + if (!get_nonnull_operand (TREE_VALUE (args), &arg_num)) + { + error ("nonnull argument has invalid operand number (argument %lu)", + (unsigned long) attr_arg_num); + *no_add_attrs = true; + return NULL_TREE; + } + + argument = TYPE_ARG_TYPES (type); + if (argument) + { + for (ck_num = 1; ; ck_num++) + { + if (!argument || ck_num == arg_num) + break; + argument = TREE_CHAIN (argument); + } + + if (!argument + || TREE_CODE (TREE_VALUE (argument)) == VOID_TYPE) + { + error ("nonnull argument with out-of-range operand number (argument %lu, operand %lu)", + (unsigned long) attr_arg_num, (unsigned long) arg_num); + *no_add_attrs = true; + return NULL_TREE; + } + + if (TREE_CODE (TREE_VALUE (argument)) != POINTER_TYPE) + { + error ("nonnull argument references non-pointer operand (argument %lu, operand %lu)", + (unsigned long) attr_arg_num, (unsigned long) arg_num); + *no_add_attrs = true; + return NULL_TREE; + } + } + } + + return NULL_TREE; +} + +/* Handle a "sentinel" attribute. */ + +static tree +handle_sentinel_attribute (tree *node, tree name, tree args, + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + tree params = TYPE_ARG_TYPES (*node); + + if (!params) + { + warning (OPT_Wattributes, + "%qE attribute requires prototypes with named arguments", name); + *no_add_attrs = true; + } + else + { + while (TREE_CHAIN (params)) + params = TREE_CHAIN (params); + + if (VOID_TYPE_P (TREE_VALUE (params))) + { + warning (OPT_Wattributes, + "%qE attribute only applies to variadic functions", name); + *no_add_attrs = true; + } + } + + if (args) + { + tree position = TREE_VALUE (args); + + if (TREE_CODE (position) != INTEGER_CST) + { + warning (0, "requested position is not an integer constant"); + *no_add_attrs = true; + } + else + { + if (tree_int_cst_lt (position, integer_zero_node)) + { + warning (0, "requested position is less than zero"); + *no_add_attrs = true; + } + } + } + + return NULL_TREE; +} + +/* Handle a "noreturn" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_noreturn_attribute (tree *node, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + tree type = TREE_TYPE (*node); + + /* See FIXME comment in c_common_attribute_table. */ + if (TREE_CODE (*node) == FUNCTION_DECL) + TREE_THIS_VOLATILE (*node) = 1; + else if (TREE_CODE (type) == POINTER_TYPE + && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE) + TREE_TYPE (*node) + = build_pointer_type + (build_type_variant (TREE_TYPE (type), + TYPE_READONLY (TREE_TYPE (type)), 1)); + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Handle a "malloc" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_malloc_attribute (tree *node, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL + && POINTER_TYPE_P (TREE_TYPE (TREE_TYPE (*node)))) + DECL_IS_MALLOC (*node) = 1; + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Fake handler for attributes we don't properly support. */ + +tree +fake_attribute_handler (tree * ARG_UNUSED (node), + tree ARG_UNUSED (name), + tree ARG_UNUSED (args), + int ARG_UNUSED (flags), + bool * ARG_UNUSED (no_add_attrs)) +{ + return NULL_TREE; +} + +/* Handle a "type_generic" attribute. */ + +static tree +handle_type_generic_attribute (tree *node, tree ARG_UNUSED (name), + tree ARG_UNUSED (args), int ARG_UNUSED (flags), + bool * ARG_UNUSED (no_add_attrs)) +{ + /* Ensure we have a function type, with no arguments. */ + gcc_assert (TREE_CODE (*node) == FUNCTION_TYPE && ! TYPE_ARG_TYPES (*node)); + + return NULL_TREE; +} + +/* ----------------------------------------------------------------------- * + * BUILTIN FUNCTIONS * + * ----------------------------------------------------------------------- */ + +/* Worker for DEF_BUILTIN. Possibly define a builtin function with one or two + names. Does not declare a non-__builtin_ function if flag_no_builtin, or + if nonansi_p and flag_no_nonansi_builtin. */ + +static void +def_builtin_1 (enum built_in_function fncode, + const char *name, + enum built_in_class fnclass, + tree fntype, tree libtype, + bool both_p, bool fallback_p, + bool nonansi_p ATTRIBUTE_UNUSED, + tree fnattrs, bool implicit_p) +{ + tree decl; + const char *libname; + + /* Preserve an already installed decl. It most likely was setup in advance + (e.g. as part of the internal builtins) for specific reasons. */ + if (built_in_decls[(int) fncode] != NULL_TREE) + return; + + gcc_assert ((!both_p && !fallback_p) + || !strncmp (name, "__builtin_", + strlen ("__builtin_"))); + + libname = name + strlen ("__builtin_"); + decl = add_builtin_function (name, fntype, fncode, fnclass, + (fallback_p ? libname : NULL), + fnattrs); + if (both_p) + /* ??? This is normally further controlled by command-line options + like -fno-builtin, but we don't have them for Ada. */ + add_builtin_function (libname, libtype, fncode, fnclass, + NULL, fnattrs); + + built_in_decls[(int) fncode] = decl; + if (implicit_p) + implicit_built_in_decls[(int) fncode] = decl; +} + +static int flag_isoc94 = 0; +static int flag_isoc99 = 0; + +/* Install what the common builtins.def offers. */ + +static void +install_builtin_functions (void) +{ +#define DEF_BUILTIN(ENUM, NAME, CLASS, TYPE, LIBTYPE, BOTH_P, FALLBACK_P, \ + NONANSI_P, ATTRS, IMPLICIT, COND) \ + if (NAME && COND) \ + def_builtin_1 (ENUM, NAME, CLASS, \ + builtin_types[(int) TYPE], \ + builtin_types[(int) LIBTYPE], \ + BOTH_P, FALLBACK_P, NONANSI_P, \ + built_in_attributes[(int) ATTRS], IMPLICIT); +#include "builtins.def" +#undef DEF_BUILTIN +} + +/* ----------------------------------------------------------------------- * + * BUILTIN FUNCTIONS * + * ----------------------------------------------------------------------- */ + +/* Install the builtin functions we might need. */ + +void +gnat_install_builtins (void) +{ + install_builtin_elementary_types (); + install_builtin_function_types (); + install_builtin_attributes (); + + /* Install builtins used by generic middle-end pieces first. Some of these + know about internal specificities and control attributes accordingly, for + instance __builtin_alloca vs no-throw and -fstack-check. We will ignore + the generic definition from builtins.def. */ + build_common_builtin_nodes (); + + /* Now, install the target specific builtins, such as the AltiVec family on + ppc, and the common set as exposed by builtins.def. */ + targetm.init_builtins (); + install_builtin_functions (); +} + #include "gt-ada-utils.h" #include "gtype-ada.h" diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1971c290f01..23c6f7e99e3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-04-21 Olivier Hainque + + * gnat.dg/bltins.adb: New testcase. + 2008-04-20 Jerry DeLisle PR fortran/35991 diff --git a/gcc/testsuite/gnat.dg/bltins.adb b/gcc/testsuite/gnat.dg/bltins.adb new file mode 100644 index 00000000000..0ceb0b95ba3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bltins.adb @@ -0,0 +1,12 @@ +-- { dg-do run } + +procedure Bltins is + + function Sqrt (F : Float) return Float; + pragma Import (Intrinsic, Sqrt, "__builtin_sqrtf"); + + F : Float := 4.0; + R : Float; +begin + R := Sqrt (F); +end;