diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2009-04-22 07:28:48 +0000 |
---|---|---|
committer | Eric Botcazou <ebotcazou@gcc.gnu.org> | 2009-04-22 07:28:48 +0000 |
commit | 0fb2335d4ccfbc928951ddeba5ead045a1dff172 (patch) | |
tree | 950ce5c9336788a41cdb4bf91464fab566a2861b | |
parent | 8ff1dd836408a49359dbac9321678ccf6d33a6f9 (diff) | |
download | gcc-0fb2335d4ccfbc928951ddeba5ead045a1dff172.zip gcc-0fb2335d4ccfbc928951ddeba5ead045a1dff172.tar.gz gcc-0fb2335d4ccfbc928951ddeba5ead045a1dff172.tar.bz2 |
fe.h (Get_External_Name): Declare.
* fe.h (Get_External_Name): Declare.
* gcc-interface/gigi.h (concat_id_with_name): Rename to...
(concat_name): ...this.
* gcc-interface/decl.c (gnat_to_gnu_entity): Rename gnu_entity_id to
gnu_entity_name and adjust for above renaming.
<E_Access_Type>: Use create_concat_name to get the name of the various
types associated with unconstrained array types.
(make_aligning_type): Adjust for above renaming.
(maybe_pad_type): Likewise.
(components_to_record): Likewise. Â Use get_identifier_with_length for
the encoding of the variant.
(get_entity_name): Use get_identifier_with_length.
(create_concat_name): Likewise. Â Use Get_External_Name if no suffix.
Do not fiddle with Name_Buffer.
(concat_id_with_name): Rename to...
(concat_name): ...this. Â Use get_identifier_with_length. Â Do not fiddle
with Name_Buffer.
* gcc-interface/utils.c (rest_of_record_type_compilation): Adjust for
above renaming.
From-SVN: r146547
-rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
-rw-r--r-- | gcc/ada/fe.h | 6 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.c | 181 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 15 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/utils.c | 24 |
5 files changed, 132 insertions, 116 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b64aedb..2bdc461 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2009-04-22 Eric Botcazou <ebotcazou@adacore.com> + + * fe.h (Get_External_Name): Declare. + * gcc-interface/gigi.h (concat_id_with_name): Rename to... + (concat_name): ...this. + * gcc-interface/decl.c (gnat_to_gnu_entity): Rename gnu_entity_id to + gnu_entity_name and adjust for above renaming. + <E_Access_Type>: Use create_concat_name to get the name of the various + types associated with unconstrained array types. + (make_aligning_type): Adjust for above renaming. + (maybe_pad_type): Likewise. + (components_to_record): Likewise. Use get_identifier_with_length for + the encoding of the variant. + (get_entity_name): Use get_identifier_with_length. + (create_concat_name): Likewise. Use Get_External_Name if no suffix. + Do not fiddle with Name_Buffer. + (concat_id_with_name): Rename to... + (concat_name): ...this. Use get_identifier_with_length. Do not fiddle + with Name_Buffer. + * gcc-interface/utils.c (rest_of_record_type_compilation): Adjust for + above renaming. + 2009-04-21 Joseph Myers <joseph@codesourcery.com> * ChangeLog, ChangeLog.ptr, ChangeLog.tree-ssa: Add copyright and diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 7e619e6..6141552 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -135,10 +135,12 @@ extern void Setup_Asm_Outputs (Node_Id); /* exp_dbug: */ #define Get_Encoded_Name exp_dbug__get_encoded_name +#define Get_External_Name exp_dbug__get_external_name #define Get_External_Name_With_Suffix exp_dbug__get_external_name_with_suffix -extern void Get_Encoded_Name (Entity_Id); -extern void Get_External_Name_With_Suffix (Entity_Id, Fat_Pointer); +extern void Get_Encoded_Name (Entity_Id); +extern void Get_External_Name (Entity_Id, Boolean); +extern void Get_External_Name_With_Suffix (Entity_Id, Fat_Pointer); /* lib: */ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 224b342..3cd8017 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -184,7 +184,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Contains the GCC size tree to be used for the GCC node. */ tree gnu_size = NULL_TREE; /* Contains the GCC name to be used for the GCC node. */ - tree gnu_entity_id; + tree gnu_entity_name; /* True if we have already saved gnu_decl as a GNAT association. */ bool saved = false; /* True if we incremented defer_incomplete_level. */ @@ -316,7 +316,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Get the name of the entity and set up the line number and filename of the original definition for use in any decl we make. */ - gnu_entity_id = get_entity_name (gnat_entity); + gnu_entity_name = get_entity_name (gnat_entity); Sloc_to_locus (Sloc (gnat_entity), &input_location); /* If we get here, it means we have not yet done anything with this @@ -560,7 +560,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (Present (Debug_Renaming_Link (gnat_entity))) { rtx addr; - gnu_decl = build_decl (VAR_DECL, gnu_entity_id, gnu_type); + gnu_decl = build_decl (VAR_DECL, gnu_entity_name, gnu_type); /* The (MEM (CONST (0))) pattern is prescribed by STABS. */ if (global_bindings_p ()) addr = gen_rtx_CONST (VOIDmode, const0_rtx); @@ -780,8 +780,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = build_unc_object_type_from_ptr (gnu_fat, gnu_type, - concat_id_with_name (gnu_entity_id, - "UNC")); + concat_name (gnu_entity_name, + "UNC")); } #ifdef MINIMUM_ATOMIC_ALIGNMENT @@ -1263,7 +1263,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || (Is_Public (gnat_entity) && (!Is_Imported (gnat_entity) || Is_Exported (gnat_entity))))) - gnu_ext_name = create_concat_name (gnat_entity, 0); + gnu_ext_name = create_concat_name (gnat_entity, NULL); /* If this is constant initialized to a static constant and the object has an aggregate type, force it to be statically @@ -1278,7 +1278,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1))) static_p = true; - gnu_decl = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, + gnu_decl = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_expr, const_flag, Is_Public (gnat_entity), imported_p || !definition, @@ -1314,7 +1314,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) accessed from within the debugger through the PARM_DECL. */ if (kind == E_Out_Parameter && definition && !optimize) { - tree param = create_param_decl (gnu_entity_id, gnu_type, false); + tree param = create_param_decl (gnu_entity_name, gnu_type, false); gnat_pushdecl (param, gnat_entity); SET_DECL_VALUE_EXPR (param, gnu_decl); DECL_HAS_VALUE_EXPR_P (param) = 1; @@ -1341,7 +1341,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Is_Aliased (Etype (gnat_entity)))) { tree gnu_corr_var - = create_true_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, + = create_true_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_expr, true, Is_Public (gnat_entity), !definition, static_p, NULL, gnat_entity); @@ -1401,7 +1401,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (No (First_Literal (gnat_entity))) { gnu_type = make_unsigned_type (esize); - TYPE_NAME (gnu_type) = gnu_entity_id; + TYPE_NAME (gnu_type) = gnu_entity_name; /* Set TYPE_STRING_FLAG for Ada Character and Wide_Character types. This is needed by the DWARF-2 back-end to distinguish between @@ -1633,7 +1633,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Create a stripped-down declaration of the original type, mainly for debugging. */ - create_type_decl (gnu_entity_id, gnu_field_type, NULL, true, + create_type_decl (gnu_entity_name, gnu_field_type, NULL, true, debug_info_p, gnat_entity); /* Don't notify the field as "addressable", since we won't be taking @@ -1671,7 +1671,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Create a stripped-down declaration of the original type, mainly for debugging. */ - create_type_decl (gnu_entity_id, gnu_field_type, NULL, true, + create_type_decl (gnu_entity_name, gnu_field_type, NULL, true, debug_info_p, gnat_entity); /* Don't notify the field as "addressable", since we won't be taking @@ -2352,7 +2352,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Attach the TYPE_STUB_DECL in case we have a parallel type. */ if (need_index_type_struct) TYPE_STUB_DECL (gnu_type) - = create_type_stub_decl (gnu_entity_id, gnu_type); + = create_type_stub_decl (gnu_entity_name, gnu_type); /* If we are at file level and this is a multi-dimensional array, we need to make a variable corresponding to the stride of the @@ -2365,7 +2365,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) for (gnu_arr_type = TREE_TYPE (gnu_type); TREE_CODE (gnu_arr_type) == ARRAY_TYPE; gnu_arr_type = TREE_TYPE (gnu_arr_type), - gnu_str_name = concat_id_with_name (gnu_str_name, "ST")) + gnu_str_name = concat_name (gnu_str_name, "ST")) { tree eltype = TREE_TYPE (gnu_arr_type); @@ -2386,8 +2386,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_SIZE_UNIT (gnu_arr_type), size_int (TYPE_ALIGN (eltype) / BITS_PER_UNIT)), - concat_id_with_name (gnu_str_name, "A_U"), - definition, 0), + concat_name (gnu_str_name, "A_U"), definition, 0), size_int (TYPE_ALIGN (eltype) / BITS_PER_UNIT)); /* ??? create_type_decl is not invoked on the inner types so @@ -2474,7 +2473,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) That's sort of "morally" true and will make it possible for the debugger to look it up by name in DWARF more easily. */ gnu_decl - = create_type_decl (gnu_entity_id, gnu_type, attr_list, + = create_type_decl (gnu_entity_name, gnu_type, attr_list, !Comes_From_Source (gnat_entity) && !Comes_From_Source (Etype (gnat_entity)), debug_info_p, gnat_entity); @@ -2688,7 +2687,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Make a node for the record. If we are not defining the record, suppress expanding incomplete types. */ gnu_type = make_node (tree_code_for_record_type (gnat_entity)); - TYPE_NAME (gnu_type) = gnu_entity_id; + TYPE_NAME (gnu_type) = gnu_entity_name; TYPE_PACKED (gnu_type) = (packed != 0) || has_rep; if (!definition) @@ -3000,7 +2999,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_temp; gnu_type = make_node (RECORD_TYPE); - TYPE_NAME (gnu_type) = gnu_entity_id; + TYPE_NAME (gnu_type) = gnu_entity_name; TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity); /* Set the size, alignment and alias set of the new type to @@ -3263,7 +3262,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = build_pointer_type (make_dummy_type (Directly_Designated_Type (gnat_entity))); - gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, + gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list, !Comes_From_Source (gnat_entity), debug_info_p, gnat_entity); this_made_decl = true; @@ -3400,13 +3399,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_ptr_array = build_pointer_type (gnu_array_type); TYPE_NAME (gnu_template_type) - = concat_id_with_name (get_entity_name (gnat_desig_equiv), - "XUB"); + = create_concat_name (gnat_desig_equiv, "XUB"); TYPE_DUMMY_P (gnu_template_type) = 1; TYPE_NAME (gnu_array_type) - = concat_id_with_name (get_entity_name (gnat_desig_equiv), - "XUA"); + = create_concat_name (gnat_desig_equiv, "XUA"); TYPE_DUMMY_P (gnu_array_type) = 1; gnu_type = make_node (RECORD_TYPE); @@ -3435,8 +3432,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_OBJECT_RECORD_TYPE (gnu_old) = make_node (RECORD_TYPE); TYPE_NAME (TYPE_OBJECT_RECORD_TYPE (gnu_old)) - = concat_id_with_name (get_entity_name (gnat_desig_equiv), - "XUT"); + = create_concat_name (gnat_desig_equiv, "XUT"); TYPE_DUMMY_P (TYPE_OBJECT_RECORD_TYPE (gnu_old)) = 1; } } @@ -3572,7 +3568,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) (TYPE_OBJECT_RECORD_TYPE (TYPE_UNCONSTRAINED_ARRAY (gnu_type))); - gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, + gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list, !Comes_From_Source (gnat_entity), debug_info_p, gnat_entity); this_made_decl = true; @@ -4133,7 +4129,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If there was no specified Interface_Name and the external and internal names of the subprogram are the same, only use the internal name to allow disambiguation of nested subprograms. */ - if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_id) + if (No (Interface_Name (gnat_entity)) + && gnu_ext_name == gnu_entity_name) gnu_ext_name = NULL_TREE; /* If we are defining the subprogram and it has an Address clause @@ -4163,14 +4160,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_address = convert (gnu_type, gnu_address); gnu_decl - = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, + = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_address, false, Is_Public (gnat_entity), extern_flag, false, NULL, gnat_entity); DECL_BY_REF_P (gnu_decl) = 1; } else if (kind == E_Subprogram_Type) - gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, + gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list, !Comes_From_Source (gnat_entity), debug_info_p, gnat_entity); else @@ -4182,7 +4179,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) public_flag = false; } - gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name, + gnu_decl = create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_param_list, inline_flag, public_flag, extern_flag, attr_list, @@ -4190,7 +4187,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (has_stub) { tree gnu_stub_decl - = create_subprog_decl (gnu_entity_id, gnu_stub_name, + = create_subprog_decl (gnu_entity_name, gnu_stub_name, gnu_stub_type, gnu_stub_param_list, inline_flag, true, extern_flag, attr_list, @@ -4296,7 +4293,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; case E_Label: - gnu_decl = create_label_decl (gnu_entity_id); + gnu_decl = create_label_decl (gnu_entity_name); break; case E_Block: @@ -4411,9 +4408,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_CODE (gnu_type) == RECORD_TYPE && TYPE_IS_PADDING_P (gnu_type)) { - gnu_entity_id = TYPE_NAME (gnu_type); - if (TREE_CODE (gnu_entity_id) == TYPE_DECL) - gnu_entity_id = DECL_NAME (gnu_entity_id); + gnu_entity_name = TYPE_NAME (gnu_type); + if (TREE_CODE (gnu_entity_name) == TYPE_DECL) + gnu_entity_name = DECL_NAME (gnu_entity_name); } set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity); @@ -4527,7 +4524,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (gnu_type)) = 1; if (!gnu_decl) - gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, + gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list, !Comes_From_Source (gnat_entity), debug_info_p, gnat_entity); else @@ -5670,7 +5667,7 @@ make_aligning_type (tree type, unsigned int align, tree size, if (TREE_CODE (name) == TYPE_DECL) name = DECL_NAME (name); - TYPE_NAME (record_type) = concat_id_with_name (name, "_ALIGN"); + TYPE_NAME (record_type) = concat_name (name, "_ALIGN"); /* Compute VOFFSET and then POS. The next byte position multiple of some alignment after some address is obtained by "and"ing the alignment minus @@ -6031,7 +6028,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, if (TREE_CODE (orig_name) == TYPE_DECL) orig_name = DECL_NAME (orig_name); - TYPE_NAME (marker) = concat_id_with_name (name, "XVS"); + TYPE_NAME (marker) = concat_name (name, "XVS"); finish_record_type (marker, create_field_decl (orig_name, integer_type_node, marker, 0, NULL_TREE, NULL_TREE, @@ -6041,9 +6038,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, add_parallel_type (TYPE_STUB_DECL (record), marker); if (size && TREE_CODE (size) != INTEGER_CST && definition) - create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE, - sizetype, TYPE_SIZE_UNIT (record), false, false, - false, false, NULL, gnat_entity); + create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, + TYPE_SIZE_UNIT (record), false, false, false, + false, NULL, gnat_entity); } rest_of_record_type_compilation (record); @@ -6605,23 +6602,20 @@ components_to_record (tree gnu_record_type, Node_Id component_list, use GNU_RECORD_TYPE if there are no fields so far. */ if (Present (variant_part)) { - tree gnu_discriminant = gnat_to_gnu (Name (variant_part)); - Node_Id variant; + Node_Id gnat_discr = Name (variant_part), variant; + tree gnu_discr = gnat_to_gnu (gnat_discr); tree gnu_name = TYPE_NAME (gnu_record_type); tree gnu_var_name - = concat_id_with_name (get_identifier (Get_Name_String - (Chars (Name (variant_part)))), - "XVN"); - tree gnu_union_type; - tree gnu_union_name; - tree gnu_union_field; + = concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))), + "XVN"); + tree gnu_union_type, gnu_union_name, gnu_union_field; tree gnu_variant_list = NULL_TREE; if (TREE_CODE (gnu_name) == TYPE_DECL) gnu_name = DECL_NAME (gnu_name); - gnu_union_name = concat_id_with_name (gnu_name, - IDENTIFIER_POINTER (gnu_var_name)); + gnu_union_name + = concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name)); /* Reuse an enclosing union if all fields are in the variant part and there is no representation clause on the record, to match @@ -6649,10 +6643,10 @@ components_to_record (tree gnu_record_type, Node_Id component_list, tree gnu_qual; Get_Variant_Encoding (variant); - gnu_inner_name = get_identifier (Name_Buffer); + gnu_inner_name = get_identifier_with_length (Name_Buffer, Name_Len); TYPE_NAME (gnu_variant_type) - = concat_id_with_name (gnu_union_name, - IDENTIFIER_POINTER (gnu_inner_name)); + = concat_name (gnu_union_name, + IDENTIFIER_POINTER (gnu_inner_name)); /* Set the alignment of the inner type in case we need to make inner objects into bitfields, but then clear it out @@ -6677,8 +6671,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list, &gnu_our_rep_list, !all_rep_and_size, all_rep, true, unchecked_union); - gnu_qual = choices_to_gnu (gnu_discriminant, - Discrete_Choices (variant)); + gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant)); Set_Present_Expr (variant, annotate_value (gnu_qual)); @@ -7749,6 +7742,17 @@ rm_size (tree gnu_type) return TYPE_SIZE (gnu_type); } +/* Return the name to be used for GNAT_ENTITY. If a type, create a + fully-qualified name, possibly with type information encoding. + Otherwise, return the name. */ + +tree +get_entity_name (Entity_Id gnat_entity) +{ + Get_Encoded_Name (gnat_entity); + return get_identifier_with_length (Name_Buffer, Name_Len); +} + /* Return an identifier representing the external name to be used for GNAT_ENTITY. If SUFFIX is specified, the name is followed by "___" and the specified suffix. */ @@ -7758,55 +7762,44 @@ create_concat_name (Entity_Id gnat_entity, const char *suffix) { Entity_Kind kind = Ekind (gnat_entity); - const char *str = (!suffix ? "" : suffix); - String_Template temp = {1, strlen (str)}; - Fat_Pointer fp = {str, &temp}; - - Get_External_Name_With_Suffix (gnat_entity, fp); + if (suffix) + { + String_Template temp = {1, strlen (suffix)}; + Fat_Pointer fp = {suffix, &temp}; + Get_External_Name_With_Suffix (gnat_entity, fp); + } + else + Get_External_Name (gnat_entity, 0); - /* A variable using the Stdcall convention (meaning we are running - on a Windows box) live in a DLL. Here we adjust its name to use - the jump-table, the _imp__NAME contains the address for the NAME - variable. */ + /* A variable using the Stdcall convention lives in a DLL. We adjust + its name to use the jump table, the _imp__NAME contains the address + for the NAME variable. */ if ((kind == E_Variable || kind == E_Constant) && Has_Stdcall_Convention (gnat_entity)) { - const char *prefix = "_imp__"; - int k, plen = strlen (prefix); - - for (k = 0; k <= Name_Len; k++) - Name_Buffer [Name_Len - k + plen] = Name_Buffer [Name_Len - k]; - strncpy (Name_Buffer, prefix, plen); + const int len = 6 + Name_Len; + char *new_name = (char *) alloca (len + 1); + strcpy (new_name, "_imp__"); + strcat (new_name, Name_Buffer); + return get_identifier_with_length (new_name, len); } - return get_identifier (Name_Buffer); + return get_identifier_with_length (Name_Buffer, Name_Len); } -/* Return the name to be used for GNAT_ENTITY. If a type, create a - fully-qualified name, possibly with type information encoding. - Otherwise, return the name. */ - -tree -get_entity_name (Entity_Id gnat_entity) -{ - Get_Encoded_Name (gnat_entity); - return get_identifier (Name_Buffer); -} - -/* Given GNU_ID, an IDENTIFIER_NODE containing a name and SUFFIX, a +/* Given GNU_NAME, an IDENTIFIER_NODE containing a name and SUFFIX, a string, return a new IDENTIFIER_NODE that is the concatenation of - the name in GNU_ID and SUFFIX. */ + the name followed by "___" and the specified suffix. */ tree -concat_id_with_name (tree gnu_id, const char *suffix) +concat_name (tree gnu_name, const char *suffix) { - int len = IDENTIFIER_LENGTH (gnu_id); - - strncpy (Name_Buffer, IDENTIFIER_POINTER (gnu_id), len); - strncpy (Name_Buffer + len, "___", 3); - len += 3; - strcpy (Name_Buffer + len, suffix); - return get_identifier (Name_Buffer); + const int len = IDENTIFIER_LENGTH (gnu_name) + 3 + strlen (suffix); + char *new_name = (char *) alloca (len + 1); + strcpy (new_name, IDENTIFIER_POINTER (gnu_name)); + strcat (new_name, "___"); + strcat (new_name, suffix); + return get_identifier_with_length (new_name, len); } #include "gt-ada-decl.h" diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 1daec92..f4113f8 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -168,20 +168,21 @@ extern tree substitute_in_type (tree t, tree f, tree r); needed to represent the object. */ extern tree rm_size (tree gnu_type); -/* Given GNU_ID, an IDENTIFIER_NODE containing a name, and SUFFIX, a - string, return a new IDENTIFIER_NODE that is the concatenation of - the name in GNU_ID and SUFFIX. */ -extern tree concat_id_with_name (tree gnu_id, const char *suffix); - /* Return the name to be used for GNAT_ENTITY. If a type, create a fully-qualified name, possibly with type information encoding. Otherwise, return the name. */ extern tree get_entity_name (Entity_Id gnat_entity); -/* Return a name for GNAT_ENTITY concatenated with two underscores and - SUFFIX. */ +/* Return an identifier representing the external name to be used for + GNAT_ENTITY. If SUFFIX is specified, the name is followed by "___" + and the specified suffix. */ extern tree create_concat_name (Entity_Id gnat_entity, const char *suffix); +/* Given GNU_NAME, an IDENTIFIER_NODE containing a name and SUFFIX, a + string, return a new IDENTIFIER_NODE that is the concatenation of + the name followed by "___" and the specified suffix. */ +extern tree concat_name (tree gnu_name, const char *suffix); + /* If true, then gigi is being called on an analyzed but unexpanded tree, and the only purpose of the call is to properly annotate types with representation information. */ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 3375c40..c1af571 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -802,22 +802,20 @@ rest_of_record_type_compilation (tree record_type) tree new_record_type = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE ? UNION_TYPE : TREE_CODE (record_type)); - tree orig_name = TYPE_NAME (record_type); - tree orig_id - = (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name) - : orig_name); - tree new_id - = concat_id_with_name (orig_id, - TREE_CODE (record_type) == QUAL_UNION_TYPE - ? "XVU" : "XVE"); + tree orig_name = TYPE_NAME (record_type), new_name; tree last_pos = bitsize_zero_node; - tree old_field; - tree prev_old_field = 0; + tree old_field, prev_old_field = NULL_TREE; - TYPE_NAME (new_record_type) = new_id; + if (TREE_CODE (orig_name) == TYPE_DECL) + orig_name = DECL_NAME (orig_name); + + new_name + = concat_name (orig_name, TREE_CODE (record_type) == QUAL_UNION_TYPE + ? "XVU" : "XVE"); + TYPE_NAME (new_record_type) = new_name; TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT; TYPE_STUB_DECL (new_record_type) - = create_type_stub_decl (new_id, new_record_type); + = create_type_stub_decl (new_name, new_record_type); DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type)) = DECL_IGNORED_P (TYPE_STUB_DECL (record_type)); TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type)); @@ -937,7 +935,7 @@ rest_of_record_type_compilation (tree record_type) else strcpy (suffix, "XVL"); - field_name = concat_id_with_name (field_name, suffix); + field_name = concat_name (field_name, suffix); } new_field = create_field_decl (field_name, field_type, |