* gcc-interface/gigi.h (ref_filename): Delete.
(Sloc_to_locus): Add clean_column parameter defaulting to false.
(build_call_raise): Adjust comment.
(build_call_raise_range): Move around.
* gcc-interface/trans.c (ref_filename): Delete.
(gigi): Fix formatting.
(block_end_locus_sink): Delete.
(Sloc_to_locus1): Tidy up and reformat. Rename into...
(Sloc_to_locus): ...this. Add default for clean_colmun parameter.
(set_expr_location_from_node1): Rename into...
(set_expr_location_from_node): ...this.
(set_end_locus_from_node): Move around. Adjust for renaming.
(Handled_Sequence_Of_Statements_to_gnu): Likewise.
(add_cleanup): Likewise.
* gcc-interface/utils2.c (expand_sloc): New static function.
(build_call_raise): Call it.
(build_call_raise_column): Likewise.
(build_call_raise_range): Likewise. Move around.
From-SVN: r227736
+2015-09-14 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/gigi.h (ref_filename): Delete.
+ (Sloc_to_locus): Add clean_column parameter defaulting to false.
+ (build_call_raise): Adjust comment.
+ (build_call_raise_range): Move around.
+ * gcc-interface/trans.c (ref_filename): Delete.
+ (gigi): Fix formatting.
+ (block_end_locus_sink): Delete.
+ (Sloc_to_locus1): Tidy up and reformat. Rename into...
+ (Sloc_to_locus): ...this. Add default for clean_colmun parameter.
+ (set_expr_location_from_node1): Rename into...
+ (set_expr_location_from_node): ...this.
+ (set_end_locus_from_node): Move around. Adjust for renaming.
+ (Handled_Sequence_Of_Statements_to_gnu): Likewise.
+ (add_cleanup): Likewise.
+ * gcc-interface/utils2.c (expand_sloc): New static function.
+ (build_call_raise): Call it.
+ (build_call_raise_column): Likewise.
+ (build_call_raise_range): Likewise. Move around.
+
2015-09-14 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils2.c (gnat_rewrite_reference) <COMPOUND_EXPR>: Add
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)))
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
{
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
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);
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
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;
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;
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);
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;
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))
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);
}
}
\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.
- 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;
*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;
+ 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);
- /* Translate the location. */
- *locus = linemap_position_for_line_and_column (map, line, column);
- }
+ /* We can have zero if pragma Source_Reference is in effect. */
+ if (line < 1)
+ line = 1;
- ref_filename
- = IDENTIFIER_POINTER
- (get_identifier
- (Get_Name_String (Debug_Source_Name (Get_Source_File_Index (Sloc)))));;
+ /* Translate the location. */
+ *locus = linemap_position_for_line_and_column (map, line, column);
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. */
+ 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. */
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;
+ }
+}
\f
/* Return a colon-separated list of encodings contained in encoded Ada
name. */
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;
- }
-}
-\f
/* 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
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. */
{
if (TREE_CODE (*node) == FUNCTION_DECL)
DECL_PURE_P (*node) = 1;
- /* ??? TODO: Support types. */
+ /* TODO: support types. */
else
{
warning (OPT_Wattributes, "%qs attribute ignored",
return fn;
}
\f
-/* 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);
+ }
- KIND says which kind of exception this is for
- (N_Raise_{Constraint,Storage,Program}_Error). */
+ 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);
+}
+
+/* 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)
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
= 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));
}
\f
/* qsort comparer for the bit positions of two constructor elements
projects / gcc.git / commitdiff