diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 39 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 7 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 19 |
3 files changed, 60 insertions, 5 deletions
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index dbacaef..b0bf586 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3769,7 +3769,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; } - /* If we have not done it yet, build the pointer type the usual way. */ + /* If we haven't done it yet, build the pointer type the usual way. */ if (!gnu_type) { /* Modify the designated type if we are pointing only to constant @@ -5229,6 +5229,42 @@ get_unpadded_type (Entity_Id gnat_entity) return type; } + +/* Return the DECL associated with the public subprogram GNAT_ENTITY but whose + type has been changed to that of the parameterless procedure, except if an + alias is already present, in which case it is returned instead. */ + +tree +get_minimal_subprog_decl (Entity_Id gnat_entity) +{ + tree gnu_entity_name, gnu_ext_name; + struct attrib *attr_list = NULL; + + /* See the E_Function/E_Procedure case of gnat_to_gnu_entity for the model + of the handling applied here. */ + + while (Present (Alias (gnat_entity))) + { + gnat_entity = Alias (gnat_entity); + if (present_gnu_tree (gnat_entity)) + return get_gnu_tree (gnat_entity); + } + + gnu_entity_name = get_entity_name (gnat_entity); + gnu_ext_name = create_concat_name (gnat_entity, NULL); + + if (Has_Stdcall_Convention (gnat_entity)) + prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE, + get_identifier ("stdcall"), NULL_TREE, + gnat_entity); + + if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_name) + gnu_ext_name = NULL_TREE; + + return + create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE, + false, true, true, true, attr_list, gnat_entity); +} /* Wrap up compilation of DECL, a TYPE_DECL, possibly deferring it. Every TYPE_DECL generated for a type definition must be passed @@ -5333,6 +5369,7 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity) } gcc_assert (Present (gnat_equiv) || type_annotate_only); + return gnat_equiv; } diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 9b14743..00f6465 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -118,6 +118,11 @@ extern void mark_out_of_scope (Entity_Id gnat_entity); /* Get the unpadded version of a GNAT type. */ extern tree get_unpadded_type (Entity_Id gnat_entity); +/* Return the DECL associated with the public subprogram GNAT_ENTITY but whose + type has been changed to that of the parameterless procedure, except if an + alias is already present, in which case it is returned instead. */ +extern tree get_minimal_subprog_decl (Entity_Id gnat_entity); + /* Create a record type that contains a SIZE bytes long field of TYPE with a starting bit position so that it is aligned to ALIGN bits, and leaving at least ROOM bytes free before the field. BASE_ALIGN is the alignment the diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 4ba6fb3..077d4a6 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1232,11 +1232,24 @@ Pragma_to_gnu (Node_Id gnat_node) static tree Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) { - tree gnu_prefix = gnat_to_gnu (Prefix (gnat_node)); - tree gnu_type = TREE_TYPE (gnu_prefix); - tree gnu_expr, gnu_result_type, gnu_result = error_mark_node; + tree gnu_prefix, gnu_type, gnu_expr; + tree gnu_result_type, gnu_result = error_mark_node; bool prefix_unused = false; + /* ??? If this is an access attribute for a public subprogram to be used in + a dispatch table, do not translate its type as it's useless there and the + parameter types might be incomplete types coming from a limited with. */ + if (Ekind (Etype (gnat_node)) == E_Access_Subprogram_Type + && Is_Dispatch_Table_Entity (Etype (gnat_node)) + && Nkind (Prefix (gnat_node)) == N_Identifier + && Is_Subprogram (Entity (Prefix (gnat_node))) + && Is_Public (Entity (Prefix (gnat_node))) + && !present_gnu_tree (Entity (Prefix (gnat_node)))) + gnu_prefix = get_minimal_subprog_decl (Entity (Prefix (gnat_node))); + else + gnu_prefix = gnat_to_gnu (Prefix (gnat_node)); + gnu_type = TREE_TYPE (gnu_prefix); + /* If the input is a NULL_EXPR, make a new one. */ if (TREE_CODE (gnu_prefix) == NULL_EXPR) { |