/* 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. */
/* 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
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);
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
|| (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
(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,
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;
|| 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);
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
/* 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
/* 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
/* 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
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);
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
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);
/* 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)
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
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;
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);
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;
}
}
(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;
/* 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
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
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,
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,
break;
case E_Label:
- gnu_decl = create_label_decl (gnu_entity_id);
+ gnu_decl = create_label_decl (gnu_entity_name);
break;
case E_Block:
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);
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
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
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,
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);
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
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
&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));
return TYPE_SIZE (gnu_type);
}
\f
+/* 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. */
{
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"
projects / gcc.git / commitdiff