OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Revert previous change, unintended.

Browse Source 
From-SVN: r195805
This commit is contained in:
Arnaud Charlet 2013-02-06 14:19:20 +01:00
parent a44bbd4889
commit 47625858b7
5 changed files with 68 additions and 256 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/gcc-interface/ada-tree.h
View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2012, Free Software Foundation, Inc. *
* Copyright (C) 1992-2013, 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- *
@ -507,5 +507,11 @@ do { \
#define LOOP_STMT_BOTTOM_COND_P(NODE) TREE_LANG_FLAG_0 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_TOP_UPDATE_P(NODE) TREE_LANG_FLAG_1 (LOOP_STMT_CHECK (NODE))
/* Optimization hints on loops. */
#define LOOP_STMT_NO_UNROLL(NODE) TREE_LANG_FLAG_2 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_UNROLL(NODE) TREE_LANG_FLAG_3 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_NO_VECTOR(NODE) TREE_LANG_FLAG_4 (LOOP_STMT_CHECK (NODE))
#define LOOP_STMT_VECTOR(NODE) TREE_LANG_FLAG_5 (LOOP_STMT_CHECK (NODE))
#define EXIT_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
#define EXIT_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)

88
gcc/ada/gcc-interface/decl.c
View File

@ -2908,12 +2908,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{
Node_Id full_definition = Declaration_Node (gnat_entity);
Node_Id record_definition = Type_Definition (full_definition);
Node_Id gnat_constr;
Entity_Id gnat_field;
tree gnu_field, gnu_field_list = NULL_TREE;
tree gnu_get_parent;
tree gnu_field, gnu_field_list = NULL_TREE, gnu_get_parent;
/* Set PACKED in keeping with gnat_to_gnu_field. */
const int packed
int packed
= Is_Packed (gnat_entity)
? 1
: Component_Alignment (gnat_entity) == Calign_Storage_Unit
@ -2923,13 +2921,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& Known_RM_Size (gnat_entity)))
? -2
: 0;
const bool has_discr = Has_Discriminants (gnat_entity);
const bool has_rep = Has_Specified_Layout (gnat_entity);
const bool is_extension
bool has_discr = Has_Discriminants (gnat_entity);
bool has_rep = Has_Specified_Layout (gnat_entity);
bool all_rep = has_rep;
bool is_extension
= (Is_Tagged_Type (gnat_entity)
&& Nkind (record_definition) == N_Derived_Type_Definition);
const bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
bool all_rep = has_rep;
bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
/* See if all fields have a rep clause. Stop when we find one
that doesn't. */
@ -3168,51 +3166,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
}
}
/* If we have a derived untagged type that renames discriminants in
the root type, the (stored) discriminants are a just copy of the
discriminants of the root type. This means that any constraints
added by the renaming in the derivation are disregarded as far
as the layout of the derived type is concerned. To rescue them,
we change the type of the (stored) discriminants to a subtype
with the bounds of the type of the visible discriminants. */
if (has_discr
&& !is_extension
&& Stored_Constraint (gnat_entity) != No_Elist)
for (gnat_constr = First_Elmt (Stored_Constraint (gnat_entity));
gnat_constr != No_Elmt;
gnat_constr = Next_Elmt (gnat_constr))
if (Nkind (Node (gnat_constr)) == N_Identifier
/* Ignore access discriminants. */
&& !Is_Access_Type (Etype (Node (gnat_constr)))
&& Ekind (Entity (Node (gnat_constr))) == E_Discriminant)
{
Entity_Id gnat_discr = Entity (Node (gnat_constr));
tree gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr));
tree gnu_ref
= gnat_to_gnu_entity (Original_Record_Component (gnat_discr),
NULL_TREE, 0);
/* GNU_REF must be an expression using a PLACEHOLDER_EXPR built
just above for one of the stored discriminants. */
gcc_assert (TREE_TYPE (TREE_OPERAND (gnu_ref, 0)) == gnu_type);
if (gnu_discr_type != TREE_TYPE (gnu_ref))
{
const unsigned prec = TYPE_PRECISION (TREE_TYPE (gnu_ref));
tree gnu_subtype
= TYPE_UNSIGNED (TREE_TYPE (gnu_ref))
? make_unsigned_type (prec) : make_signed_type (prec);
TREE_TYPE (gnu_subtype) = TREE_TYPE (gnu_ref);
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
SET_TYPE_RM_MIN_VALUE (gnu_subtype,
TYPE_MIN_VALUE (gnu_discr_type));
SET_TYPE_RM_MAX_VALUE (gnu_subtype,
TYPE_MAX_VALUE (gnu_discr_type));
TREE_TYPE (gnu_ref)
= TREE_TYPE (TREE_OPERAND (gnu_ref, 1)) = gnu_subtype;
}
}
/* Add the fields into the record type and finish it up. */
components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, false,
@ -4125,10 +4078,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_stub_type = NULL_TREE, gnu_stub_name = NULL_TREE;
tree gnu_ext_name = create_concat_name (gnat_entity, NULL);
Entity_Id gnat_param;
enum inline_status_t inline_status
= Has_Pragma_No_Inline (gnat_entity)
? is_suppressed
: (Is_Inlined (gnat_entity) ? is_enabled : is_disabled);
bool inline_flag = Is_Inlined (gnat_entity);
bool public_flag = Is_Public (gnat_entity) || imported_p;
bool extern_flag
= (Is_Public (gnat_entity) && !definition) || imported_p;
@ -4684,15 +4634,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_decl
= create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type,
gnu_param_list, inline_status,
public_flag, extern_flag, artificial_flag,
attr_list, gnat_entity);
gnu_param_list, inline_flag, public_flag,
extern_flag, artificial_flag, attr_list,
gnat_entity);
if (has_stub)
{
tree gnu_stub_decl
= create_subprog_decl (gnu_entity_name, gnu_stub_name,
gnu_stub_type, gnu_stub_param_list,
inline_status, true, extern_flag,
inline_flag, true, extern_flag,
false, attr_list, gnat_entity);
SET_DECL_FUNCTION_STUB (gnu_decl, gnu_stub_decl);
}
@ -5425,7 +5375,7 @@ get_minimal_subprog_decl (Entity_Id gnat_entity)
return
create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE,
is_disabled, true, true, true, attr_list, gnat_entity);
false, true, true, true, attr_list, gnat_entity);
}
/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
@ -6014,7 +5964,7 @@ elaborate_entity (Entity_Id gnat_entity)
Present (gnat_field);
gnat_field = Next_Discriminant (gnat_field),
gnat_discriminant_expr = Next_Elmt (gnat_discriminant_expr))
/* Ignore access discriminants. */
/* ??? For now, ignore access discriminants. */
if (!Is_Access_Type (Etype (Node (gnat_discriminant_expr))))
elaborate_expression (Node (gnat_discriminant_expr),
gnat_entity, get_entity_name (gnat_field),
@ -7660,20 +7610,20 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
{
vec<subst_pair> gnu_list = vNULL;
Entity_Id gnat_discrim;
Node_Id gnat_constr;
Node_Id gnat_value;
for (gnat_discrim = First_Stored_Discriminant (gnat_type),
gnat_constr = First_Elmt (Stored_Constraint (gnat_subtype));
gnat_value = First_Elmt (Stored_Constraint (gnat_subtype));
Present (gnat_discrim);
gnat_discrim = Next_Stored_Discriminant (gnat_discrim),
gnat_constr = Next_Elmt (gnat_constr))
gnat_value = Next_Elmt (gnat_value))
/* Ignore access discriminants. */
if (!Is_Access_Type (Etype (Node (gnat_constr))))
if (!Is_Access_Type (Etype (Node (gnat_value))))
{
tree gnu_field = gnat_to_gnu_field_decl (gnat_discrim);
tree replacement = convert (TREE_TYPE (gnu_field),
elaborate_expression
(Node (gnat_constr), gnat_subtype,
(Node (gnat_value), gnat_subtype,
get_entity_name (gnat_discrim),
definition, true, false));
subst_pair s = {gnu_field, replacement};

18
gcc/ada/gcc-interface/gigi.h
View File

@ -430,17 +430,6 @@ enum exception_info_kind
exception_column
};
/* Define the inline status of a subprogram. */
enum inline_status_t
{
/* Inlining is suppressed for the subprogram. */
is_suppressed,
/* No inlining is requested for the subprogram. */
is_disabled,
/* Inlining is requested for the subprogram. */
is_enabled
};
extern GTY(()) tree gnat_std_decls[(int) ADT_LAST];
extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
@ -729,14 +718,13 @@ extern tree create_label_decl (tree, Node_Id);
node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of
PARM_DECL nodes chained through the DECL_CHAIN field).
INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is
used for the position of the decl. */
extern tree create_subprog_decl (tree subprog_name, tree asm_name,
tree subprog_type, tree param_decl_list,
enum inline_status_t inline_status,
bool public_flag, bool extern_flag,
bool artificial_flag,
bool inline_flag, bool public_flag,
bool extern_flag, bool artificial_flag,
struct attrib *attr_list, Node_Id gnat_node);
/* Set up the framework for generating code for SUBPROG_DECL, a subprogram

180
gcc/ada/gcc-interface/trans.c
View File

@ -36,8 +36,6 @@
#include "gimple.h"
#include "bitmap.h"
#include "cgraph.h"
#include "diagnostic.h"
#include "opts.h"
#include "target.h"
#include "common/common-target.h"
@ -212,7 +210,7 @@ typedef struct range_check_info_d *range_check_info;
/* Structure used to record information for a loop. */
struct GTY(()) loop_info_d {
tree stmt;
tree label;
tree loop_var;
vec<range_check_info, va_gc> *checks;
};
@ -413,16 +411,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
memory. */
malloc_decl
= create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE,
ftype, NULL_TREE, is_disabled, true, true, true,
NULL, Empty);
ftype, NULL_TREE, false, true, true, true, NULL,
Empty);
DECL_IS_MALLOC (malloc_decl) = 1;
/* malloc32 is a function declaration tree for a function to allocate
32-bit memory on a 64-bit system. Needed only on 64-bit VMS. */
malloc32_decl
= create_subprog_decl (get_identifier ("__gnat_malloc32"), NULL_TREE,
ftype, NULL_TREE, is_disabled, true, true, true,
NULL, Empty);
ftype, NULL_TREE, false, true, true, true, NULL,
Empty);
DECL_IS_MALLOC (malloc32_decl) = 1;
/* free is a function declaration tree for a function to free memory. */
@ -431,16 +429,14 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
build_function_type_list (void_type_node,
ptr_void_type_node,
NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL,
Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
/* This is used for 64-bit multiplication with overflow checking. */
mulv64_decl
= create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE,
build_function_type_list (int64_type, int64_type,
int64_type, NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL,
Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
/* Name of the _Parent field in tagged record types. */
parent_name_id = get_identifier (Get_Name_String (Name_uParent));
@ -461,7 +457,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
= create_subprog_decl
(get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
NULL_TREE, build_function_type_list (jmpbuf_ptr_type, NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
DECL_IGNORED_P (get_jmpbuf_decl) = 1;
set_jmpbuf_decl
@ -469,7 +465,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
(get_identifier ("system__soft_links__set_jmpbuf_address_soft"),
NULL_TREE, build_function_type_list (void_type_node, jmpbuf_ptr_type,
NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
DECL_IGNORED_P (set_jmpbuf_decl) = 1;
/* setjmp returns an integer and has one operand, which is a pointer to
@ -479,7 +475,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
(get_identifier ("__builtin_setjmp"), NULL_TREE,
build_function_type_list (integer_type_node, jmpbuf_ptr_type,
NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
@ -489,7 +485,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
= create_subprog_decl
(get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE,
build_function_type_list (void_type_node, jmpbuf_ptr_type, NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF;
@ -499,27 +495,27 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
begin_handler_decl
= create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE,
ftype, NULL_TREE, is_disabled, true, true, true,
NULL, Empty);
ftype, NULL_TREE, false, true, true, true, NULL,
Empty);
DECL_IGNORED_P (begin_handler_decl) = 1;
end_handler_decl
= create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
ftype, NULL_TREE, is_disabled, true, true, true,
NULL, Empty);
ftype, NULL_TREE, false, true, true, true, NULL,
Empty);
DECL_IGNORED_P (end_handler_decl) = 1;
unhandled_except_decl
= create_subprog_decl (get_identifier ("__gnat_unhandled_except_handler"),
NULL_TREE,
ftype, NULL_TREE, is_disabled, true, true, true,
NULL, Empty);
ftype, NULL_TREE, false, true, true, true, NULL,
Empty);
DECL_IGNORED_P (unhandled_except_decl) = 1;
reraise_zcx_decl
= create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE,
ftype, NULL_TREE, is_disabled, true, true, true,
NULL, Empty);
ftype, NULL_TREE, false, true, true, true, NULL,
Empty);
/* Indicate that these never return. */
DECL_IGNORED_P (reraise_zcx_decl) = 1;
TREE_THIS_VOLATILE (reraise_zcx_decl) = 1;
@ -539,7 +535,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
build_pointer_type
(unsigned_char_type_node),
integer_type_node, NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
TREE_THIS_VOLATILE (decl) = 1;
TREE_SIDE_EFFECTS (decl) = 1;
TREE_TYPE (decl)
@ -572,7 +568,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
(get_identifier ("system__soft_links__get_gnat_exception"), NULL_TREE,
build_function_type_list (build_pointer_type (except_type_node),
NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
DECL_IGNORED_P (get_excptr_decl) = 1;
raise_nodefer_decl
@ -581,7 +577,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
build_function_type_list (void_type_node,
build_pointer_type (except_type_node),
NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
NULL_TREE, false, true, true, true, NULL, Empty);
/* Indicate that it never returns. */
TREE_THIS_VOLATILE (raise_nodefer_decl) = 1;
@ -754,7 +750,7 @@ build_raise_check (int check, enum exception_info_kind kind)
result
= create_subprog_decl (get_identifier (Name_Buffer),
NULL_TREE, ftype, NULL_TREE,
is_disabled, true, true, true, NULL, Empty);
false, true, true, true, NULL, Empty);
/* Indicate that it never returns. */
TREE_THIS_VOLATILE (result) = 1;
@ -1188,11 +1184,11 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
static tree
Pragma_to_gnu (Node_Id gnat_node)
{
tree gnu_result = alloc_stmt_list ();
Node_Id gnat_temp;
tree gnu_result = alloc_stmt_list ();
/* Do nothing if we are just annotating types and check for (and ignore)
unrecognized pragmas. */
/* Check for (and ignore) unrecognized pragma and do nothing if we are just
annotating types. */
if (type_annotate_only
|| !Is_Pragma_Name (Chars (Pragma_Identifier (gnat_node))))
return gnu_result;
@ -1254,37 +1250,6 @@ Pragma_to_gnu (Node_Id gnat_node)
}
break;
case Pragma_Loop_Optimize:
for (gnat_temp = First (Pragma_Argument_Associations (gnat_node));
Present (gnat_temp);
gnat_temp = Next (gnat_temp))
{
tree gnu_loop_stmt = gnu_loop_stack ->last ()->stmt;
switch (Chars (Expression (gnat_temp)))
{
case Name_No_Unroll:
LOOP_STMT_NO_UNROLL (gnu_loop_stmt) = 1;
break;
case Name_Unroll:
LOOP_STMT_UNROLL (gnu_loop_stmt) = 1;
break;
case Name_No_Vector:
LOOP_STMT_NO_VECTOR (gnu_loop_stmt) = 1;
break;
case Name_Vector:
LOOP_STMT_VECTOR (gnu_loop_stmt) = 1;
break;
default:
gcc_unreachable ();
}
}
break;
case Pragma_Optimize:
switch (Chars (Expression
(First (Pragma_Argument_Associations (gnat_node)))))
@ -1313,87 +1278,6 @@ Pragma_to_gnu (Node_Id gnat_node)
if (write_symbols == NO_DEBUG)
post_error ("must specify -g?", gnat_node);
break;
case Pragma_Warnings:
{
Node_Id gnat_expr;
/* Preserve the location of the pragma. */
const location_t location = input_location;
struct cl_option_handlers handlers;
unsigned int option_index;
diagnostic_t kind;
bool imply;
gnat_temp = First (Pragma_Argument_Associations (gnat_node));
/* This is the String form: pragma Warnings (String). */
if (Nkind (Expression (gnat_temp)) == N_String_Literal)
{
kind = DK_WARNING;
gnat_expr = Expression (gnat_temp);
imply = true;
}
/* This is the On/Off form: pragma Warnings (On | Off [,String]). */
else if (Nkind (Expression (gnat_temp)) == N_Identifier)
{
switch (Chars (Expression (gnat_temp)))
{
case Name_Off:
kind = DK_IGNORED;
break;
case Name_On:
kind = DK_WARNING;
break;
default:
gcc_unreachable ();
}
if (Present (Next (gnat_temp)))
{
/* pragma Warnings (On | Off, Name) is handled differently. */
if (Nkind (Expression (Next (gnat_temp))) != N_String_Literal)
break;
gnat_expr = Expression (Next (gnat_temp));
}
else
gnat_expr = Empty;
imply = false;
}
else
gcc_unreachable ();
/* This is the same implementation as in the C family of compilers. */
if (Present (gnat_expr))
{
tree gnu_expr = gnat_to_gnu (gnat_expr);
const char *opt_string = TREE_STRING_POINTER (gnu_expr);
const int len = TREE_STRING_LENGTH (gnu_expr);
if (len < 3 || opt_string[0] != '-' || opt_string[1] != 'W')
break;
for (option_index = 0;
option_index < cl_options_count;
option_index++)
if (strcmp (cl_options[option_index].opt_text, opt_string) == 0)
break;
}
else
option_index = 0;
set_default_handlers (&handlers);
control_warning_option (option_index, (int) kind, imply, location,
CL_Ada, &handlers, &global_options,
&global_options_set, global_dc);
}
break;
default:
break;
}
return gnu_result;
@ -2460,8 +2344,8 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
&DECL_SOURCE_LOCATION (gnu_loop_label));
LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label;
/* Save the statement for later reuse. */
gnu_loop_info->stmt = gnu_loop_stmt;
/* Save the label so that a corresponding N_Exit_Statement can find it. */
gnu_loop_info->label = gnu_loop_label;
/* Set the condition under which the loop must keep going.
For the case "LOOP .... END LOOP;" the condition is always true. */
@ -2815,7 +2699,7 @@ establish_gnat_vms_condition_handler (void)
ptr_void_type_node,
ptr_void_type_node,
NULL_TREE),
NULL_TREE, is_disabled, true, true, true, NULL,
NULL_TREE, false, true, true, true, NULL,
Empty);
/* ??? DECL_CONTEXT shouldn't have been set because of DECL_EXTERNAL. */
@ -4869,7 +4753,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
tree gnu_elab_proc_decl
= create_subprog_decl
(create_concat_name (gnat_unit_entity, body_p ? "elabb" : "elabs"),
NULL_TREE, void_ftype, NULL_TREE, is_disabled, true, false, true, NULL,
NULL_TREE, void_ftype, NULL_TREE, false, true, false, true, NULL,
gnat_unit);
struct elab_info *info;
@ -5797,7 +5681,7 @@ gnat_to_gnu (Node_Id gnat_node)
create_subprog_decl (create_concat_name
(Entity (Prefix (gnat_node)),
attr == Attr_Elab_Body ? "elabb" : "elabs"),
NULL_TREE, void_ftype, NULL_TREE, is_disabled,
NULL_TREE, void_ftype, NULL_TREE, false,
true, true, true, NULL, gnat_node);
gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr);
@ -6406,7 +6290,7 @@ gnat_to_gnu (Node_Id gnat_node)
? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE),
(Present (Name (gnat_node))
? get_gnu_tree (Entity (Name (gnat_node)))
: LOOP_STMT_LABEL (gnu_loop_stack->last ()->stmt)));
: gnu_loop_stack->last ()->label));
break;
case N_Simple_Return_Statement:

30
gcc/ada/gcc-interface/utils.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2013, 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- *
@ -2621,14 +2621,14 @@ create_label_decl (tree label_name, Node_Id gnat_node)
node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of
PARM_DECL nodes chained through the DECL_CHAIN field).
INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are
used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is
used for the position of the decl. */
tree
create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type,
tree param_decl_list, enum inline_status_t inline_status,
bool public_flag, bool extern_flag, bool artificial_flag,
tree param_decl_list, bool inline_flag, bool public_flag,
bool extern_flag, bool artificial_flag,
struct attrib *attr_list, Node_Id gnat_node)
{
tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name,
@ -2642,7 +2642,7 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type,
function in the current unit since it is private to the other unit.
We could inline the nested function as well but it's probably better
to err on the side of too little inlining. */
if (inline_status != is_enabled
if (!inline_flag
&& !public_flag
&& current_function_decl
&& DECL_DECLARED_INLINE_P (current_function_decl)
@ -2651,24 +2651,8 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type,
DECL_ARTIFICIAL (subprog_decl) = artificial_flag;
DECL_EXTERNAL (subprog_decl) = extern_flag;
switch (inline_status)
{
case is_suppressed:
DECL_UNINLINABLE (subprog_decl) = 1;
break;
case is_disabled:
break;
case is_enabled:
DECL_DECLARED_INLINE_P (subprog_decl) = 1;
DECL_NO_INLINE_WARNING_P (subprog_decl) = artificial_flag;
break;
default:
gcc_unreachable ();
}
DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag;
DECL_NO_INLINE_WARNING_P (subprog_decl) = inline_flag && artificial_flag;
TREE_PUBLIC (subprog_decl) = public_flag;
TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type);