static void validate_unchecked_conversion (Node_Id);
static tree maybe_implicit_deref (tree);
static void set_expr_location_from_node (tree, Node_Id);
+static void set_expr_location_from_node1 (tree, Node_Id, bool);
+static bool Sloc_to_locus1 (Source_Ptr, location_t *, bool);
static bool set_end_locus_from_node (tree, Node_Id);
static void set_gnu_expr_location_from_node (tree, Node_Id);
static int lvalue_required_p (Node_Id, tree, bool, bool, bool);
tree int64_type = gnat_type_for_size (64, 0);
struct elab_info *info;
int i;
-#ifdef ORDINARY_MAP_INSTANCE
- struct line_map *map;
-#endif
max_gnat_nodes = max_gnat_node;
type_annotate_only = (gigi_operating_mode == 1);
- /* ??? Disable the generation of the SCO instance table until after the
- back-end supports instance based debug info discriminators. */
- Generate_SCO_Instance_Table = False;
-
for (i = 0; i < number_file; i++)
{
/* Use the identifier table to make a permanent copy of the filename as
/* We create the line map for a source file at once, with a fixed number
of columns chosen to avoid jumping over the next power of 2. */
linemap_add (line_table, LC_ENTER, 0, filename, 1);
-#ifdef ORDINARY_MAP_INSTANCE
- map = LINEMAPS_ORDINARY_MAP_AT (line_table, i);
- if (flag_debug_instances)
- ORDINARY_MAP_INSTANCE (map) = file_info_ptr[i].Instance;
-#endif
linemap_line_start (line_table, file_info_ptr[i].Num_Source_Lines, 252);
linemap_position_for_column (line_table, 252 - 1);
linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
NULL_TREE, is_disabled, true, true, true, NULL, Empty);
DECL_IGNORED_P (get_excptr_decl) = 1;
+ set_exception_parameter_decl
+ = create_subprog_decl
+ (get_identifier ("__gnat_set_exception_parameter"), NULL_TREE,
+ build_function_type_list (void_type_node,
+ ptr_void_type_node,
+ ptr_void_type_node,
+ NULL_TREE),
+ NULL_TREE, is_disabled, true, true, true, NULL, Empty);
+
raise_nodefer_decl
= create_subprog_decl
(get_identifier ("__gnat_raise_nodefer_with_msg"), NULL_TREE,
others_decl
= create_var_decl (get_identifier ("OTHERS"),
get_identifier ("__gnat_others_value"),
- integer_type_node, NULL_TREE, true, false, true, false,
- NULL, Empty);
+ unsigned_char_type_node,
+ NULL_TREE, true, false, true, false, NULL, Empty);
all_others_decl
= create_var_decl (get_identifier ("ALL_OTHERS"),
get_identifier ("__gnat_all_others_value"),
- integer_type_node, NULL_TREE, true, false, true, false,
- NULL, Empty);
+ unsigned_char_type_node,
+ NULL_TREE, true, false, true, false, NULL, Empty);
unhandled_others_decl
= create_var_decl (get_identifier ("UNHANDLED_OTHERS"),
get_identifier ("__gnat_unhandled_others_value"),
- integer_type_node, NULL_TREE, true, false, true, false,
- NULL, Empty);
+ unsigned_char_type_node,
+ NULL_TREE, true, false, true, false, NULL, Empty);
main_identifier_node = get_identifier ("main");
static tree
Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
{
+ const Node_Id gnat_prefix = Prefix (gnat_node);
tree gnu_prefix, gnu_type, gnu_expr;
tree gnu_result_type, gnu_result = error_mark_node;
bool prefix_unused = false;
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)));
+ && Nkind (gnat_prefix) == N_Identifier
+ && Is_Subprogram (Entity (gnat_prefix))
+ && Is_Public (Entity (gnat_prefix))
+ && !present_gnu_tree (Entity (gnat_prefix)))
+ gnu_prefix = get_minimal_subprog_decl (Entity (gnat_prefix));
else
- gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
+ gnu_prefix = gnat_to_gnu (gnat_prefix);
gnu_type = TREE_TYPE (gnu_prefix);
/* If the input is a NULL_EXPR, make a new one. */
since it can use a special calling convention on some platforms,
which cannot be propagated to the access type. */
else if (attribute == Attr_Access
- && Nkind (Prefix (gnat_node)) == N_Identifier
- && is_cplusplus_method (Entity (Prefix (gnat_node))))
+ && Nkind (gnat_prefix) == N_Identifier
+ && is_cplusplus_method (Entity (gnat_prefix)))
post_error ("access to C++ constructor or member function not allowed",
gnat_node);
/* If this is a dereference and we have a special dynamic constrained
subtype on the prefix, use it to compute the size; otherwise, use
the designated subtype. */
- if (Nkind (Prefix (gnat_node)) == N_Explicit_Dereference)
+ if (Nkind (gnat_prefix) == N_Explicit_Dereference)
{
- Node_Id gnat_deref = Prefix (gnat_node);
Node_Id gnat_actual_subtype
- = Actual_Designated_Subtype (gnat_deref);
+ = Actual_Designated_Subtype (gnat_prefix);
tree gnu_ptr_type
- = TREE_TYPE (gnat_to_gnu (Prefix (gnat_deref)));
+ = TREE_TYPE (gnat_to_gnu (Prefix (gnat_prefix)));
if (TYPE_IS_FAT_OR_THIN_POINTER_P (gnu_ptr_type)
&& Present (gnat_actual_subtype))
align = DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1)) / BITS_PER_UNIT;
else
{
- Node_Id gnat_prefix = Prefix (gnat_node);
Entity_Id gnat_type = Etype (gnat_prefix);
unsigned int double_align;
bool is_capped_double, align_clause;
: 1), i;
struct parm_attr_d *pa = NULL;
Entity_Id gnat_param = Empty;
+ bool unconstrained_ptr_deref = false;
/* Make sure any implicit dereference gets done. */
gnu_prefix = maybe_implicit_deref (gnu_prefix);
gnu_prefix = maybe_unconstrained_array (gnu_prefix);
- /* We treat unconstrained array In parameters specially. */
- if (!Is_Constrained (Etype (Prefix (gnat_node))))
- {
- Node_Id gnat_prefix = Prefix (gnat_node);
-
- /* This is the direct case. */
- if (Nkind (gnat_prefix) == N_Identifier
- && Ekind (Entity (gnat_prefix)) == E_In_Parameter)
- gnat_param = Entity (gnat_prefix);
-
- /* This is the indirect case. Note that we need to be sure that
- the access value cannot be null as we'll hoist the load. */
- if (Nkind (gnat_prefix) == N_Explicit_Dereference
- && Nkind (Prefix (gnat_prefix)) == N_Identifier
- && Ekind (Entity (Prefix (gnat_prefix))) == E_In_Parameter
- && Can_Never_Be_Null (Entity (Prefix (gnat_prefix))))
- gnat_param = Entity (Prefix (gnat_prefix));
+ /* We treat unconstrained array In parameters specially. We also note
+ whether we are dereferencing a pointer to unconstrained array. */
+ if (!Is_Constrained (Etype (gnat_prefix)))
+ switch (Nkind (gnat_prefix))
+ {
+ case N_Identifier:
+ /* This is the direct case. */
+ if (Ekind (Entity (gnat_prefix)) == E_In_Parameter)
+ gnat_param = Entity (gnat_prefix);
+ break;
+
+ case N_Explicit_Dereference:
+ /* This is the indirect case. Note that we need to be sure that
+ the access value cannot be null as we'll hoist the load. */
+ if (Nkind (Prefix (gnat_prefix)) == N_Identifier
+ && Ekind (Entity (Prefix (gnat_prefix))) == E_In_Parameter)
+ {
+ if (Can_Never_Be_Null (Entity (Prefix (gnat_prefix))))
+ gnat_param = Entity (Prefix (gnat_prefix));
+ }
+ else
+ unconstrained_ptr_deref = true;
+ break;
+
+ default:
+ break;
}
/* If the prefix is the view conversion of a constrained array to an
{
gnu_result
= build1 (SAVE_EXPR, TREE_TYPE (gnu_result), gnu_result);
- if (attribute == Attr_First)
- pa->first = gnu_result;
- else if (attribute == Attr_Last)
- pa->last = gnu_result;
- else
- pa->length = gnu_result;
+ switch (attribute)
+ {
+ case Attr_First:
+ pa->first = gnu_result;
+ break;
+
+ case Attr_Last:
+ pa->last = gnu_result;
+ break;
+
+ case Attr_Length:
+ case Attr_Range_Length:
+ pa->length = gnu_result;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
}
- /* Set the source location onto the predicate of the condition in the
- 'Length case but do not do it if the expression is cached to avoid
- messing up the debug info. */
- else if ((attribute == Attr_Range_Length || attribute == Attr_Length)
- && TREE_CODE (gnu_result) == COND_EXPR
- && EXPR_P (TREE_OPERAND (gnu_result, 0)))
- set_expr_location_from_node (TREE_OPERAND (gnu_result, 0),
- gnat_node);
+ /* Otherwise, evaluate it each time it is referenced. */
+ else
+ switch (attribute)
+ {
+ case Attr_First:
+ case Attr_Last:
+ /* If we are dereferencing a pointer to unconstrained array, we
+ need to capture the value because the pointed-to bounds may
+ subsequently be released. */
+ if (unconstrained_ptr_deref)
+ gnu_result
+ = build1 (SAVE_EXPR, TREE_TYPE (gnu_result), gnu_result);
+ break;
+
+ case Attr_Length:
+ case Attr_Range_Length:
+ /* Set the source location onto the predicate of the condition
+ but not if the expression is cached to avoid messing up the
+ debug info. */
+ if (TREE_CODE (gnu_result) == COND_EXPR
+ && EXPR_P (TREE_OPERAND (gnu_result, 0)))
+ set_expr_location_from_node (TREE_OPERAND (gnu_result, 0),
+ gnat_node);
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
break;
}
case Attr_Mechanism_Code:
{
+ Entity_Id gnat_obj = Entity (gnat_prefix);
int code;
- Entity_Id gnat_obj = Entity (Prefix (gnat_node));
prefix_unused = true;
gnu_result_type = get_unpadded_type (Etype (gnat_node));
it has a side-effect. But don't do it if the prefix is just an entity
name. However, if an access check is needed, we must do it. See second
example in AARM 11.6(5.e). */
- if (prefix_unused && TREE_SIDE_EFFECTS (gnu_prefix)
- && !Is_Entity_Name (Prefix (gnat_node)))
- gnu_result = build_compound_expr (TREE_TYPE (gnu_result), gnu_prefix,
- gnu_result);
+ if (prefix_unused
+ && TREE_SIDE_EFFECTS (gnu_prefix)
+ && !Is_Entity_Name (gnat_prefix))
+ gnu_result
+ = build_compound_expr (TREE_TYPE (gnu_result), gnu_prefix, gnu_result);
*gnu_result_type_p = gnu_result_type;
return gnu_result;
/* First, if we have computed a small number of invariant conditions for
range checks applied to the iteration variable, then initialize these
- conditions in front of the loop. Otherwise, leave them set to True.
+ conditions in front of the loop. Otherwise, leave them set to true.
??? The heuristics need to be improved, by taking into account the
following datapoints:
/* Prune also the candidates that are referenced by nested functions. */
node = cgraph_get_create_node (fndecl);
for (node = node->nested; node; node = node->next_nested)
- walk_tree_without_duplicates (&DECL_SAVED_TREE (node->symbol.decl), prune_nrv_r,
+ walk_tree_without_duplicates (&DECL_SAVED_TREE (node->decl), prune_nrv_r,
&data);
if (bitmap_empty_p (nrv))
return;
{
tree gnu_retval;
+ gnu_return_var_stack->pop ();
+
add_stmt (gnu_result);
add_stmt (build1 (LABEL_EXPR, void_type_node,
gnu_return_label_stack->last ()));
tree gnu_result;
tree gnu_expr;
Node_Id gnat_temp;
+ /* Node providing the sloc for the cleanup actions. */
+ Node_Id gnat_cleanup_loc_node = (Present (End_Label (gnat_node)) ?
+ End_Label (gnat_node) :
+ gnat_node);
/* The GCC exception handling mechanism can handle both ZCX and SJLJ schemes
and we have our own SJLJ mechanism. To call the GCC mechanism, we call
/* When we exit this block, restore the saved value. */
add_cleanup (build_call_n_expr (set_jmpbuf_decl, 1, gnu_jmpsave_decl),
- End_Label (gnat_node));
+ gnat_cleanup_loc_node);
}
/* If we are to call a function when exiting this block, add a cleanup
so we must register this cleanup after the EH cleanup just above. */
if (at_end)
add_cleanup (build_call_n_expr (gnat_to_gnu (At_End_Proc (gnat_node)), 0),
- End_Label (gnat_node));
+ gnat_cleanup_loc_node);
/* Now build the tree for the declarations and statements inside this block.
If this is SJLJ, set our jmp_buf as the current buffer. */
/* Now make the TRY_CATCH_EXPR for the block. */
gnu_result = build2 (TRY_CATCH_EXPR, void_type_node,
gnu_inner_block, gnu_handlers);
- /* Set a location. We need to find a uniq location for the dispatching
+ /* Set a location. We need to find a unique location for the dispatching
code, otherwise we can get coverage or debugging issues. Try with
the location of the end label. */
if (Present (End_Label (gnat_node))
&& Sloc_to_locus (Sloc (End_Label (gnat_node)), &locus))
SET_EXPR_LOCATION (gnu_result, locus);
else
- set_expr_location_from_node (gnu_result, gnat_node);
+ /* Clear column information so that the exception handler of an
+ implicit transient block does not incorrectly inherit the slocs
+ of a decision, which would otherwise confuse control flow based
+ coverage analysis tools. */
+ set_expr_location_from_node1 (gnu_result, gnat_node, true);
}
else
gnu_result = gnu_inner_block;
add_stmt_with_node (build_call_n_expr (begin_handler_decl, 1,
gnu_incoming_exc_ptr),
gnat_node);
- /* ??? We don't seem to have an End_Label at hand to set the location. */
+
+ /* Declare and initialize the choice parameter, if present. */
+ if (Present (Choice_Parameter (gnat_node)))
+ {
+ tree gnu_param = gnat_to_gnu_entity
+ (Choice_Parameter (gnat_node), NULL_TREE, 1);
+
+ add_stmt (build_call_n_expr
+ (set_exception_parameter_decl, 2,
+ build_unary_op (ADDR_EXPR, NULL_TREE, gnu_param),
+ gnu_incoming_exc_ptr));
+ }
+
+ /* We don't have an End_Label at hand to set the location of the cleanup
+ actions, so we use that of the exception handler itself instead. */
add_cleanup (build_call_n_expr (end_handler_decl, 1, gnu_incoming_exc_ptr),
- Empty);
+ gnat_node);
add_stmt_list (Statements (gnat_node));
gnat_poplevel ();
/* Process any pragmas and actions following the unit. */
add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node)));
add_stmt_list (Actions (Aux_Decls_Node (gnat_node)));
- finalize_from_with_types ();
+ finalize_from_limited_with ();
/* Save away what we've made so far and record this potential elaboration
procedure. */
Present (gnat_temp);
gnat_temp = Next_Formal_With_Extras (gnat_temp))
if (Is_Itype (Etype (gnat_temp))
- && !From_With_Type (Etype (gnat_temp)))
+ && !From_Limited_With (Etype (gnat_temp)))
gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
/* Then the result type, set to Standard_Void_Type for procedures. */
Entity_Id gnat_temp_type
= Etype (Defining_Entity (Specification (gnat_node)));
- if (Is_Itype (gnat_temp_type) && !From_With_Type (gnat_temp_type))
+ if (Is_Itype (gnat_temp_type) && !From_Limited_With (gnat_temp_type))
gnat_to_gnu_entity (Etype (gnat_temp_type), NULL_TREE, 0);
}
gnu_result = end_stmt_group ();
break;
+ case N_Freeze_Generic_Entity:
+ gnu_result = alloc_stmt_list ();
+ break;
+
case N_Itype_Reference:
if (!present_gnu_tree (Itype (gnat_node)))
process_type (Itype (gnat_node));
}
/* Add GNU_CLEANUP, a cleanup action, to the current code group and
- set its location to that of GNAT_NODE if present. */
+ set its location to that of GNAT_NODE if present, but with column info
+ cleared so that conditional branches generated as part of the cleanup
+ code do not interfere with coverage analysis tools. */
static void
add_cleanup (tree gnu_cleanup, Node_Id gnat_node)
{
if (Present (gnat_node))
- set_expr_location_from_node (gnu_cleanup, gnat_node);
+ set_expr_location_from_node1 (gnu_cleanup, gnat_node, true);
append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups);
}
\f
/* Convert SLOC into LOCUS. Return true if SLOC corresponds to a source code
location and false if it doesn't. In the former case, set the Gigi global
- variable REF_FILENAME to the simple debug file name as given by sinput. */
+ variable REF_FILENAME to the simple debug file name as given by sinput.
+ If clear_column is true, set column information to 0. */
-bool
-Sloc_to_locus (Source_Ptr Sloc, location_t *locus)
+static bool
+Sloc_to_locus1 (Source_Ptr Sloc, location_t *locus, bool clear_column)
{
if (Sloc == No_Location)
return false;
{
Source_File_Index file = Get_Source_File_Index (Sloc);
Logical_Line_Number line = Get_Logical_Line_Number (Sloc);
- Column_Number column = Get_Column_Number (Sloc);
+ Column_Number column = (clear_column ? 0 : Get_Column_Number (Sloc));
struct line_map *map = LINEMAPS_ORDINARY_MAP_AT (line_table, file - 1);
/* We can have zero if pragma Source_Reference is in effect. */
return true;
}
+/* Similar to the above, not clearing the column information. */
+
+bool
+Sloc_to_locus (Source_Ptr Sloc, location_t *locus)
+{
+ return Sloc_to_locus1 (Sloc, locus, false);
+}
+
/* Similar to set_expr_location, but start with the Sloc of GNAT_NODE and
don't do anything if it doesn't correspond to a source location. */
static void
-set_expr_location_from_node (tree node, Node_Id gnat_node)
+set_expr_location_from_node1 (tree node, Node_Id gnat_node, bool clear_column)
{
location_t locus;
- if (!Sloc_to_locus (Sloc (gnat_node), &locus))
+ if (!Sloc_to_locus1 (Sloc (gnat_node), &locus, clear_column))
return;
SET_EXPR_LOCATION (node, locus);
}
+/* Similar to the above, not clearing the column information. */
+
+static void
+set_expr_location_from_node (tree node, Node_Id gnat_node)
+{
+ set_expr_location_from_node1 (node, gnat_node, false);
+}
+
/* More elaborate version of set_expr_location_from_node to be used in more
general contexts, for example the result of the translation of a generic
GNAT node. */
String_Template temp;
Fat_Pointer fp;
- temp.Low_Bound = 1, temp.High_Bound = strlen (msg);
- fp.Array = msg, fp.Bounds = &temp;
- if (Present (node))
- Error_Msg_N (fp, node);
+ if (No (node))
+ return;
+
+ temp.Low_Bound = 1;
+ temp.High_Bound = strlen (msg);
+ fp.Bounds = &temp;
+ fp.Array = msg;
+ Error_Msg_N (fp, node);
}
/* Similar to post_error, but NODE is the node at which to post the error and
String_Template temp;
Fat_Pointer fp;
- temp.Low_Bound = 1, temp.High_Bound = strlen (msg);
- fp.Array = msg, fp.Bounds = &temp;
- if (Present (node))
- Error_Msg_NE (fp, node, ent);
+ if (No (node))
+ return;
+
+ temp.Low_Bound = 1;
+ temp.High_Bound = strlen (msg);
+ fp.Bounds = &temp;
+ fp.Array = msg;
+ Error_Msg_NE (fp, node, ent);
}
/* Similar to post_error_ne, but NUM is the number to use for the '^'. */
gnat_node = Present (gnat_end_label) ? gnat_end_label : gnat_node;
/* Some expanded subprograms have neither an End_Label nor a Sloc
- attached. Notify that to callers. */
+ attached. Notify that to callers. For a block statement with no
+ End_Label, clear column information, so that the tree for a
+ transient block does not receive the sloc of a source condition. */
- if (!Sloc_to_locus (Sloc (gnat_node), &end_locus))
+ if (!Sloc_to_locus1 (Sloc (gnat_node), &end_locus,
+ No (gnat_end_label) &&
+ (Nkind (gnat_node) == N_Block_Statement)))
return false;
switch (TREE_CODE (gnu_node))
projects / thirdparty / gcc.git / blobdiff