{
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
&& 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. */
}
}
- /* 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,
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;
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);
}
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
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),
{
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};
#include "gimple.h"
#include "bitmap.h"
#include "cgraph.h"
-#include "diagnostic.h"
-#include "opts.h"
#include "target.h"
#include "common/common-target.h"
/* 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;
};
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. */
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));
= 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
(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
(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;
= 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;
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;
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)
(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
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;
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;
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;
}
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)))))
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;
&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. */
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. */
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;
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);
? 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:
OSDN Git Service
