===================================================================
@@ -5278,7 +5278,7 @@ builtin_decl_for (tree name)
heavily inspired from the "C" family implementation, with chunks copied
verbatim from there.
- Two obvious TODO candidates are
+ Two obvious improvement candidates are:
o Use a more efficient name/decl mapping scheme
o Devise a middle-end infrastructure to avoid having to copy
pieces between front-ends. */
@@ -5627,7 +5627,7 @@ handle_pure_attribute (tree *node, tree
{
if (TREE_CODE (*node) == FUNCTION_DECL)
DECL_PURE_P (*node) = 1;
- /* ??? TODO: Support types. */
+ /* TODO: support types. */
else
{
warning (OPT_Wattributes, "%qs attribute ignored",
===================================================================
@@ -6241,7 +6241,7 @@ elaborate_expression_1 (tree gnu_expr, E
Returning the variable ensures the caller will use it in generated
code. Note that there is no need for a location if the debug info
contains an integer constant.
- FIXME: when the encoding-based debug scheme is dropped, move this
+ TODO: when the encoding-based debug scheme is dropped, move this
condition to the top-level IF block: we will not need to create a
variable anymore in such cases, then. */
if (use_variable || (need_debug && !TREE_CONSTANT (gnu_expr)))
===================================================================
@@ -1754,25 +1754,58 @@ build_call_n_expr (tree fndecl, int n, .
return fn;
}
-/* Call a function that raises an exception and pass the line number and file
- name, if requested. MSG says which exception function to call.
+/* Expand the SLOC of GNAT_NODE, if present, into tree location information
+ pointed to by FILENAME, LINE and COL. Fall back to the current location
+ if GNAT_NODE is absent or has no SLOC. */
- GNAT_NODE is the gnat node conveying the source location for which the
- error should be signaled, or Empty in which case the error is signaled on
- the current ref_file_name/input_line.
+static void
+expand_sloc (Node_Id gnat_node, tree *filename, tree *line, tree *col)
+{
+ const char *str;
+ int line_number, column_number;
+
+ if (Debug_Flag_NN || Exception_Locations_Suppressed)
+ {
+ str = "";
+ line_number = 0;
+ column_number = 0;
+ }
+ else if (Present (gnat_node) && Sloc (gnat_node) != No_Location)
+ {
+ str = Get_Name_String
+ (Debug_Source_Name (Get_Source_File_Index (Sloc (gnat_node))));
+ line_number = Get_Logical_Line_Number (Sloc (gnat_node));
+ column_number = Get_Column_Number (Sloc (gnat_node));
+ }
+ else
+ {
+ str = lbasename (LOCATION_FILE (input_location));
+ line_number = LOCATION_LINE (input_location);
+ column_number = LOCATION_COLUMN (input_location);
+ }
+
+ const int len = strlen (str);
+ *filename = build_string (len, str);
+ TREE_TYPE (*filename) = build_array_type (unsigned_char_type_node,
+ build_index_type (size_int (len)));
+ *line = build_int_cst (NULL_TREE, line_number);
+ if (col)
+ *col = build_int_cst (NULL_TREE, column_number);
+}
- KIND says which kind of exception this is for
- (N_Raise_{Constraint,Storage,Program}_Error). */
+/* Build a call to a function that raises an exception and passes file name
+ and line number, if requested. MSG says which exception function to call.
+ GNAT_NODE is the node conveying the source location for which the error
+ should be signaled, or Empty in which case the error is signaled for the
+ current location. KIND says which kind of exception node this is for,
+ among N_Raise_{Constraint,Storage,Program}_Error. */
tree
build_call_raise (int msg, Node_Id gnat_node, char kind)
{
tree fndecl = gnat_raise_decls[msg];
tree label = get_exception_label (kind);
- tree filename;
- int line_number;
- const char *str;
- int len;
+ tree filename, line;
/* If this is to be done as a goto, handle that case. */
if (label)
@@ -1780,8 +1813,7 @@ build_call_raise (int msg, Node_Id gnat_
Entity_Id local_raise = Get_Local_Raise_Call_Entity ();
tree gnu_result = build1 (GOTO_EXPR, void_type_node, label);
- /* If Local_Raise is present, generate
- Local_Raise (exception'Identity); */
+ /* If Local_Raise is present, build Local_Raise (Exception'Identity). */
if (Present (local_raise))
{
tree gnu_local_raise
@@ -1792,138 +1824,63 @@ build_call_raise (int msg, Node_Id gnat_
= build_call_n_expr (gnu_local_raise, 1,
build_unary_op (ADDR_EXPR, NULL_TREE,
gnu_exception_entity));
-
- gnu_result = build2 (COMPOUND_EXPR, void_type_node,
- gnu_call, gnu_result);}
+ gnu_result
+ = build2 (COMPOUND_EXPR, void_type_node, gnu_call, gnu_result);
+ }
return gnu_result;
}
- str
- = (Debug_Flag_NN || Exception_Locations_Suppressed)
- ? ""
- : (gnat_node != Empty && Sloc (gnat_node) != No_Location)
- ? IDENTIFIER_POINTER
- (get_identifier (Get_Name_String
- (Debug_Source_Name
- (Get_Source_File_Index (Sloc (gnat_node))))))
- : ref_filename;
-
- len = strlen (str);
- filename = build_string (len, str);
- line_number
- = (gnat_node != Empty && Sloc (gnat_node) != No_Location)
- ? Get_Logical_Line_Number (Sloc(gnat_node))
- : LOCATION_LINE (input_location);
-
- TREE_TYPE (filename) = build_array_type (unsigned_char_type_node,
- build_index_type (size_int (len)));
+ expand_sloc (gnat_node, &filename, &line, NULL);
return
build_call_n_expr (fndecl, 2,
build1 (ADDR_EXPR,
build_pointer_type (unsigned_char_type_node),
filename),
- build_int_cst (NULL_TREE, line_number));
+ line);
}
-/* Similar to build_call_raise, for an index or range check exception as
- determined by MSG, with extra information generated of the form
- "INDEX out of range FIRST..LAST". */
+/* Similar to build_call_raise, with extra information about the column
+ where the check failed. */
tree
-build_call_raise_range (int msg, Node_Id gnat_node,
- tree index, tree first, tree last)
+build_call_raise_column (int msg, Node_Id gnat_node)
{
tree fndecl = gnat_raise_decls_ext[msg];
- tree filename;
- int line_number, column_number;
- const char *str;
- int len;
-
- str
- = (Debug_Flag_NN || Exception_Locations_Suppressed)
- ? ""
- : (gnat_node != Empty && Sloc (gnat_node) != No_Location)
- ? IDENTIFIER_POINTER
- (get_identifier (Get_Name_String
- (Debug_Source_Name
- (Get_Source_File_Index (Sloc (gnat_node))))))
- : ref_filename;
-
- len = strlen (str);
- filename = build_string (len, str);
- if (gnat_node != Empty && Sloc (gnat_node) != No_Location)
- {
- line_number = Get_Logical_Line_Number (Sloc (gnat_node));
- column_number = Get_Column_Number (Sloc (gnat_node));
- }
- else
- {
- line_number = LOCATION_LINE (input_location);
- column_number = 0;
- }
+ tree filename, line, col;
- TREE_TYPE (filename) = build_array_type (unsigned_char_type_node,
- build_index_type (size_int (len)));
+ expand_sloc (gnat_node, &filename, &line, &col);
return
- build_call_n_expr (fndecl, 6,
+ build_call_n_expr (fndecl, 3,
build1 (ADDR_EXPR,
build_pointer_type (unsigned_char_type_node),
filename),
- build_int_cst (NULL_TREE, line_number),
- build_int_cst (NULL_TREE, column_number),
- convert (integer_type_node, index),
- convert (integer_type_node, first),
- convert (integer_type_node, last));
+ line, col);
}
-/* Similar to build_call_raise, with extra information about the column
- where the check failed. */
+/* Similar to build_call_raise_column, for an index or range check exception ,
+ with extra information of the form "INDEX out of range FIRST..LAST". */
tree
-build_call_raise_column (int msg, Node_Id gnat_node)
+build_call_raise_range (int msg, Node_Id gnat_node,
+ tree index, tree first, tree last)
{
tree fndecl = gnat_raise_decls_ext[msg];
- tree filename;
- int line_number, column_number;
- const char *str;
- int len;
-
- str
- = (Debug_Flag_NN || Exception_Locations_Suppressed)
- ? ""
- : (gnat_node != Empty && Sloc (gnat_node) != No_Location)
- ? IDENTIFIER_POINTER
- (get_identifier (Get_Name_String
- (Debug_Source_Name
- (Get_Source_File_Index (Sloc (gnat_node))))))
- : ref_filename;
-
- len = strlen (str);
- filename = build_string (len, str);
- if (gnat_node != Empty && Sloc (gnat_node) != No_Location)
- {
- line_number = Get_Logical_Line_Number (Sloc (gnat_node));
- column_number = Get_Column_Number (Sloc (gnat_node));
- }
- else
- {
- line_number = LOCATION_LINE (input_location);
- column_number = 0;
- }
+ tree filename, line, col;
- TREE_TYPE (filename) = build_array_type (unsigned_char_type_node,
- build_index_type (size_int (len)));
+ expand_sloc (gnat_node, &filename, &line, &col);
return
- build_call_n_expr (fndecl, 3,
+ build_call_n_expr (fndecl, 6,
build1 (ADDR_EXPR,
build_pointer_type (unsigned_char_type_node),
filename),
- build_int_cst (NULL_TREE, line_number),
- build_int_cst (NULL_TREE, column_number));
+ line, col,
+ convert (integer_type_node, index),
+ convert (integer_type_node, first),
+ convert (integer_type_node, last));
}
/* qsort comparer for the bit positions of two constructor elements
===================================================================
@@ -227,9 +227,6 @@ extern Node_Id error_gnat_node;
types with representation information. */
extern bool type_annotate_only;
-/* Current file name without path. */
-extern const char *ref_filename;
-
/* This structure must be kept synchronized with Call_Back_End. */
struct File_Info_Type
{
@@ -288,9 +285,10 @@ extern int gnat_gimplify_expr (tree *exp
extern void process_type (Entity_Id gnat_entity);
/* 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. */
-extern bool Sloc_to_locus (Source_Ptr Sloc, location_t *locus);
+ location and false if it doesn't. If CLEAR_COLUMN is true, set the column
+ information to 0. */
+extern bool Sloc_to_locus (Source_Ptr Sloc, location_t *locus,
+ bool clear_column = false);
/* Post an error message. MSG is the error message, properly annotated.
NODE is the node at which to post the error and the node to use for the
@@ -874,27 +872,23 @@ extern tree build_compound_expr (tree re
this doesn't fold the call, hence it will always return a CALL_EXPR. */
extern tree build_call_n_expr (tree fndecl, int n, ...);
-/* Call a function that raises an exception and pass the line number and file
- name, if requested. MSG says which exception function to call.
-
- GNAT_NODE is the gnat node conveying the source location for which the
- error should be signaled, or Empty in which case the error is signaled on
- the current ref_file_name/input_line.
-
- KIND says which kind of exception this is for
- (N_Raise_{Constraint,Storage,Program}_Error). */
+/* Build a call to a function that raises an exception and passes file name
+ and line number, if requested. MSG says which exception function to call.
+ GNAT_NODE is the node conveying the source location for which the error
+ should be signaled, or Empty in which case the error is signaled for the
+ current location. KIND says which kind of exception node this is for,
+ among N_Raise_{Constraint,Storage,Program}_Error. */
extern tree build_call_raise (int msg, Node_Id gnat_node, char kind);
-/* Similar to build_call_raise, for an index or range check exception as
- determined by MSG, with extra information generated of the form
- "INDEX out of range FIRST..LAST". */
-extern tree build_call_raise_range (int msg, Node_Id gnat_node,
- tree index, tree first, tree last);
-
/* Similar to build_call_raise, with extra information about the column
where the check failed. */
extern tree build_call_raise_column (int msg, Node_Id gnat_node);
+/* Similar to build_call_raise_column, for an index or range check exception ,
+ with extra information of the form "INDEX out of range FIRST..LAST". */
+extern tree build_call_raise_range (int msg, Node_Id gnat_node,
+ tree index, tree first, tree last);
+
/* Return a CONSTRUCTOR of TYPE whose elements are V. This is not the
same as build_constructor in the language-independent tree.c. */
extern tree gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v);
===================================================================
@@ -75,13 +75,6 @@
instead. */
#define ALLOCA_THRESHOLD 1000
-/* In configurations where blocks have no end_locus attached, just
- sink assignments into a dummy global. */
-#ifndef BLOCK_SOURCE_END_LOCATION
-static location_t block_end_locus_sink;
-#define BLOCK_SOURCE_END_LOCATION(BLOCK) block_end_locus_sink
-#endif
-
/* Pointers to front-end tables accessed through macros. */
struct Node *Nodes_Ptr;
struct Flags *Flags_Ptr;
@@ -104,10 +97,6 @@ Node_Id error_gnat_node;
types with representation information. */
bool type_annotate_only;
-/* Current filename without path. */
-const char *ref_filename;
-
-
/* List of N_Validate_Unchecked_Conversion nodes in the unit. */
static vec<Node_Id> gnat_validate_uc_list;
@@ -255,11 +244,9 @@ static tree extract_values (tree, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id);
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_expr_location_from_node (tree, Node_Id, bool = false);
static void set_gnu_expr_location_from_node (tree, Node_Id);
+static bool set_end_locus_from_node (tree, Node_Id);
static int lvalue_required_p (Node_Id, tree, bool, bool, bool);
static tree build_raise_check (int, enum exception_info_kind);
static tree create_init_temporary (const char *, tree, tree *, Node_Id);
@@ -5014,7 +5001,7 @@ Handled_Sequence_Of_Statements_to_gnu (N
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);
+ set_expr_location_from_node (gnu_result, gnat_node, true);
}
else
gnu_result = gnu_inner_block;
@@ -7772,7 +7759,7 @@ add_decl_expr (tree gnu_decl, Entity_Id
add_stmt_with_node (gnu_stmt, gnat_entity);
/* If this is a variable and an initializer is attached to it, it must be
- valid for the context. Similar to init_const in create_var_decl_1. */
+ valid for the context. Similar to init_const in create_var_decl. */
if (TREE_CODE (gnu_decl) == VAR_DECL
&& (gnu_init = DECL_INITIAL (gnu_decl)) != NULL_TREE
&& (!gnat_types_compatible_p (type, TREE_TYPE (gnu_init))
@@ -7840,7 +7827,7 @@ static void
add_cleanup (tree gnu_cleanup, Node_Id gnat_node)
{
if (Present (gnat_node))
- set_expr_location_from_node1 (gnu_cleanup, gnat_node, true);
+ set_expr_location_from_node (gnu_cleanup, gnat_node, true);
append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups);
}
@@ -9507,12 +9494,11 @@ maybe_implicit_deref (tree exp)
}
/* 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.
- If clear_column is true, set column information to 0. */
+ location and false if it doesn't. If CLEAR_COLUMN is true, set the column
+ information to 0. */
-static bool
-Sloc_to_locus1 (Source_Ptr Sloc, location_t *locus, bool clear_column)
+bool
+Sloc_to_locus (Source_Ptr Sloc, location_t *locus, bool clear_column)
{
if (Sloc == No_Location)
return false;
@@ -9522,59 +9508,37 @@ Sloc_to_locus1 (Source_Ptr Sloc, locatio
*locus = BUILTINS_LOCATION;
return false;
}
- else
- {
- Source_File_Index file = Get_Source_File_Index (Sloc);
- Logical_Line_Number line = Get_Logical_Line_Number (Sloc);
- Column_Number column = (clear_column ? 0 : Get_Column_Number (Sloc));
- line_map_ordinary *map = LINEMAPS_ORDINARY_MAP_AT (line_table, file - 1);
-
- /* We can have zero if pragma Source_Reference is in effect. */
- if (line < 1)
- line = 1;
-
- /* Translate the location. */
- *locus = linemap_position_for_line_and_column (map, line, column);
- }
-
- ref_filename
- = IDENTIFIER_POINTER
- (get_identifier
- (Get_Name_String (Debug_Source_Name (Get_Source_File_Index (Sloc)))));;
- return true;
-}
+ Source_File_Index file = Get_Source_File_Index (Sloc);
+ Logical_Line_Number line = Get_Logical_Line_Number (Sloc);
+ Column_Number column = (clear_column ? 0 : Get_Column_Number (Sloc));
+ line_map_ordinary *map = LINEMAPS_ORDINARY_MAP_AT (line_table, file - 1);
+
+ /* We can have zero if pragma Source_Reference is in effect. */
+ if (line < 1)
+ line = 1;
-/* Similar to the above, not clearing the column information. */
+ /* Translate the location. */
+ *locus = linemap_position_for_line_and_column (map, line, column);
-bool
-Sloc_to_locus (Source_Ptr Sloc, location_t *locus)
-{
- return Sloc_to_locus1 (Sloc, locus, false);
+ return true;
}
/* 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. */
+ don't do anything if it doesn't correspond to a source location. And,
+ if CLEAR_COLUMN is true, set the column information to 0. */
static void
-set_expr_location_from_node1 (tree node, Node_Id gnat_node, bool clear_column)
+set_expr_location_from_node (tree node, Node_Id gnat_node, bool clear_column)
{
location_t locus;
- if (!Sloc_to_locus1 (Sloc (gnat_node), &locus, clear_column))
+ if (!Sloc_to_locus (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. */
@@ -9609,6 +9573,65 @@ set_gnu_expr_location_from_node (tree no
break;
}
}
+
+/* Set the end_locus information for GNU_NODE, if any, from an explicit end
+ location associated with GNAT_NODE or GNAT_NODE itself, whichever makes
+ most sense. Return true if a sensible assignment was performed. */
+
+static bool
+set_end_locus_from_node (tree gnu_node, Node_Id gnat_node)
+{
+ Node_Id gnat_end_label;
+ location_t end_locus;
+
+ /* Pick the GNAT node of which we'll take the sloc to assign to the GCC node
+ end_locus when there is one. We consider only GNAT nodes with a possible
+ End_Label attached. If the End_Label actually was unassigned, fallback
+ on the original node. We'd better assign an explicit sloc associated with
+ the outer construct in any case. */
+
+ switch (Nkind (gnat_node))
+ {
+ case N_Package_Body:
+ case N_Subprogram_Body:
+ case N_Block_Statement:
+ gnat_end_label = End_Label (Handled_Statement_Sequence (gnat_node));
+ break;
+
+ case N_Package_Declaration:
+ gnat_end_label = End_Label (Specification (gnat_node));
+ break;
+
+ default:
+ return false;
+ }
+
+ if (Present (gnat_end_label))
+ gnat_node = gnat_end_label;
+
+ /* Some expanded subprograms have neither an End_Label nor a Sloc
+ 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,
+ No (gnat_end_label)
+ && (Nkind (gnat_node) == N_Block_Statement)))
+ return false;
+
+ switch (TREE_CODE (gnu_node))
+ {
+ case BIND_EXPR:
+ BLOCK_SOURCE_END_LOCATION (BIND_EXPR_BLOCK (gnu_node)) = end_locus;
+ return true;
+
+ case FUNCTION_DECL:
+ DECL_STRUCT_FUNCTION (gnu_node)->function_end_locus = end_locus;
+ return true;
+
+ default:
+ return false;
+ }
+}
/* Return a colon-separated list of encodings contained in encoded Ada
name. */
@@ -9679,65 +9702,6 @@ post_error_ne_num (const char *msg, Node
post_error_ne (msg, node, ent);
}
-/* Set the end_locus information for GNU_NODE, if any, from an explicit end
- location associated with GNAT_NODE or GNAT_NODE itself, whichever makes
- most sense. Return true if a sensible assignment was performed. */
-
-static bool
-set_end_locus_from_node (tree gnu_node, Node_Id gnat_node)
-{
- Node_Id gnat_end_label = Empty;
- location_t end_locus;
-
- /* Pick the GNAT node of which we'll take the sloc to assign to the GCC node
- end_locus when there is one. We consider only GNAT nodes with a possible
- End_Label attached. If the End_Label actually was unassigned, fallback
- on the original node. We'd better assign an explicit sloc associated with
- the outer construct in any case. */
-
- switch (Nkind (gnat_node))
- {
- case N_Package_Body:
- case N_Subprogram_Body:
- case N_Block_Statement:
- gnat_end_label = End_Label (Handled_Statement_Sequence (gnat_node));
- break;
-
- case N_Package_Declaration:
- gnat_end_label = End_Label (Specification (gnat_node));
- break;
-
- default:
- return false;
- }
-
- 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. 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_locus1 (Sloc (gnat_node), &end_locus,
- No (gnat_end_label) &&
- (Nkind (gnat_node) == N_Block_Statement)))
- return false;
-
- switch (TREE_CODE (gnu_node))
- {
- case BIND_EXPR:
- BLOCK_SOURCE_END_LOCATION (BIND_EXPR_BLOCK (gnu_node)) = end_locus;
- return true;
-
- case FUNCTION_DECL:
- DECL_STRUCT_FUNCTION (gnu_node)->function_end_locus = end_locus;
- return true;
-
- default:
- return false;
- }
-}
-
/* Similar to post_error_ne, but T is a GCC tree representing the number to
write. If T represents a constant, the text inside curly brackets in
MSG will be output (presumably including a '^'). Otherwise it will not
===================================================================
@@ -658,7 +658,7 @@ gnat_get_array_descr_info (const_tree ty
info->ndimensions = i;
convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (type);
- /* TODO: For row major ordering, we probably want to emit nothing and
+ /* TODO: for row major ordering, we probably want to emit nothing and
instead specify it as the default in Dw_TAG_compile_unit. */
info->ordering = (convention_fortran_p
? array_descr_ordering_column_major