Commit ba464315 by Eric Botcazou Committed by Eric Botcazou

gigi.h (ref_filename): Delete.

	* 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
parent 92d5f5ab
2015-09-14 Eric Botcazou <ebotcazou@adacore.com> 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 * gcc-interface/utils2.c (gnat_rewrite_reference) <COMPOUND_EXPR>: Add
another acceptable pattern for the RHS. another acceptable pattern for the RHS.
......
...@@ -6241,7 +6241,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s, ...@@ -6241,7 +6241,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
Returning the variable ensures the caller will use it in generated 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 code. Note that there is no need for a location if the debug info
contains an integer constant. 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 condition to the top-level IF block: we will not need to create a
variable anymore in such cases, then. */ variable anymore in such cases, then. */
if (use_variable || (need_debug && !TREE_CONSTANT (gnu_expr))) if (use_variable || (need_debug && !TREE_CONSTANT (gnu_expr)))
......
...@@ -227,9 +227,6 @@ extern Node_Id error_gnat_node; ...@@ -227,9 +227,6 @@ extern Node_Id error_gnat_node;
types with representation information. */ types with representation information. */
extern bool type_annotate_only; 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. */ /* This structure must be kept synchronized with Call_Back_End. */
struct File_Info_Type struct File_Info_Type
{ {
...@@ -288,9 +285,10 @@ extern int gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, ...@@ -288,9 +285,10 @@ extern int gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
extern void process_type (Entity_Id gnat_entity); extern void process_type (Entity_Id gnat_entity);
/* Convert SLOC into LOCUS. Return true if SLOC corresponds to a source code /* 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 location and false if it doesn't. If CLEAR_COLUMN is true, set the column
variable REF_FILENAME to the simple debug file name as given by sinput. */ information to 0. */
extern bool Sloc_to_locus (Source_Ptr Sloc, location_t *locus); 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. /* 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 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 result_type, tree stmt_operand, ...@@ -874,27 +872,23 @@ extern tree build_compound_expr (tree result_type, tree stmt_operand,
this doesn't fold the call, hence it will always return a CALL_EXPR. */ this doesn't fold the call, hence it will always return a CALL_EXPR. */
extern tree build_call_n_expr (tree fndecl, int n, ...); extern tree build_call_n_expr (tree fndecl, int n, ...);
/* Call a function that raises an exception and pass the line number and file /* Build a call to a function that raises an exception and passes file name
name, if requested. MSG says which exception function to call. 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
GNAT_NODE is the gnat node conveying the source location for which the should be signaled, or Empty in which case the error is signaled for the
error should be signaled, or Empty in which case the error is signaled on current location. KIND says which kind of exception node this is for,
the current ref_file_name/input_line. among N_Raise_{Constraint,Storage,Program}_Error. */
KIND says which kind of exception this is for
(N_Raise_{Constraint,Storage,Program}_Error). */
extern tree build_call_raise (int msg, Node_Id gnat_node, char kind); 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 /* Similar to build_call_raise, with extra information about the column
where the check failed. */ where the check failed. */
extern tree build_call_raise_column (int msg, Node_Id gnat_node); 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 /* Return a CONSTRUCTOR of TYPE whose elements are V. This is not the
same as build_constructor in the language-independent tree.c. */ same as build_constructor in the language-independent tree.c. */
extern tree gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v); extern tree gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v);
......
...@@ -658,7 +658,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info) ...@@ -658,7 +658,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
info->ndimensions = i; info->ndimensions = i;
convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (type); 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. */ instead specify it as the default in Dw_TAG_compile_unit. */
info->ordering = (convention_fortran_p info->ordering = (convention_fortran_p
? array_descr_ordering_column_major ? array_descr_ordering_column_major
......
...@@ -5278,7 +5278,7 @@ builtin_decl_for (tree name) ...@@ -5278,7 +5278,7 @@ builtin_decl_for (tree name)
heavily inspired from the "C" family implementation, with chunks copied heavily inspired from the "C" family implementation, with chunks copied
verbatim from there. verbatim from there.
Two obvious TODO candidates are Two obvious improvement candidates are:
o Use a more efficient name/decl mapping scheme o Use a more efficient name/decl mapping scheme
o Devise a middle-end infrastructure to avoid having to copy o Devise a middle-end infrastructure to avoid having to copy
pieces between front-ends. */ pieces between front-ends. */
...@@ -5627,7 +5627,7 @@ handle_pure_attribute (tree *node, tree name, tree ARG_UNUSED (args), ...@@ -5627,7 +5627,7 @@ handle_pure_attribute (tree *node, tree name, tree ARG_UNUSED (args),
{ {
if (TREE_CODE (*node) == FUNCTION_DECL) if (TREE_CODE (*node) == FUNCTION_DECL)
DECL_PURE_P (*node) = 1; DECL_PURE_P (*node) = 1;
/* ??? TODO: Support types. */ /* TODO: support types. */
else else
{ {
warning (OPT_Wattributes, "%qs attribute ignored", warning (OPT_Wattributes, "%qs attribute ignored",
......
...@@ -1754,25 +1754,58 @@ build_call_n_expr (tree fndecl, int n, ...) ...@@ -1754,25 +1754,58 @@ build_call_n_expr (tree fndecl, int n, ...)
return fn; return fn;
} }
/* Call a function that raises an exception and pass the line number and file /* Expand the SLOC of GNAT_NODE, if present, into tree location information
name, if requested. MSG says which exception function to call. 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 static void
error should be signaled, or Empty in which case the error is signaled on expand_sloc (Node_Id gnat_node, tree *filename, tree *line, tree *col)
the current ref_file_name/input_line. {
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 const int len = strlen (str);
(N_Raise_{Constraint,Storage,Program}_Error). */ *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 tree
build_call_raise (int msg, Node_Id gnat_node, char kind) build_call_raise (int msg, Node_Id gnat_node, char kind)
{ {
tree fndecl = gnat_raise_decls[msg]; tree fndecl = gnat_raise_decls[msg];
tree label = get_exception_label (kind); tree label = get_exception_label (kind);
tree filename; tree filename, line;
int line_number;
const char *str;
int len;
/* If this is to be done as a goto, handle that case. */ /* If this is to be done as a goto, handle that case. */
if (label) if (label)
...@@ -1780,8 +1813,7 @@ build_call_raise (int msg, Node_Id gnat_node, char kind) ...@@ -1780,8 +1813,7 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
Entity_Id local_raise = Get_Local_Raise_Call_Entity (); Entity_Id local_raise = Get_Local_Raise_Call_Entity ();
tree gnu_result = build1 (GOTO_EXPR, void_type_node, label); tree gnu_result = build1 (GOTO_EXPR, void_type_node, label);
/* If Local_Raise is present, generate /* If Local_Raise is present, build Local_Raise (Exception'Identity). */
Local_Raise (exception'Identity); */
if (Present (local_raise)) if (Present (local_raise))
{ {
tree gnu_local_raise tree gnu_local_raise
...@@ -1792,138 +1824,63 @@ build_call_raise (int msg, Node_Id gnat_node, char kind) ...@@ -1792,138 +1824,63 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
= build_call_n_expr (gnu_local_raise, 1, = build_call_n_expr (gnu_local_raise, 1,
build_unary_op (ADDR_EXPR, NULL_TREE, build_unary_op (ADDR_EXPR, NULL_TREE,
gnu_exception_entity)); gnu_exception_entity));
gnu_result
gnu_result = build2 (COMPOUND_EXPR, void_type_node, = build2 (COMPOUND_EXPR, void_type_node, gnu_call, gnu_result);
gnu_call, gnu_result);} }
return gnu_result; return gnu_result;
} }
str expand_sloc (gnat_node, &filename, &line, NULL);
= (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)));
return return
build_call_n_expr (fndecl, 2, build_call_n_expr (fndecl, 2,
build1 (ADDR_EXPR, build1 (ADDR_EXPR,
build_pointer_type (unsigned_char_type_node), build_pointer_type (unsigned_char_type_node),
filename), filename),
build_int_cst (NULL_TREE, line_number)); line);
} }
/* Similar to build_call_raise, for an index or range check exception as /* Similar to build_call_raise, with extra information about the column
determined by MSG, with extra information generated of the form where the check failed. */
"INDEX out of range FIRST..LAST". */
tree tree
build_call_raise_range (int msg, Node_Id gnat_node, build_call_raise_column (int msg, Node_Id gnat_node)
tree index, tree first, tree last)
{ {
tree fndecl = gnat_raise_decls_ext[msg]; tree fndecl = gnat_raise_decls_ext[msg];
tree filename; tree filename, line, col;
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_TYPE (filename) = build_array_type (unsigned_char_type_node, expand_sloc (gnat_node, &filename, &line, &col);
build_index_type (size_int (len)));
return return
build_call_n_expr (fndecl, 6, build_call_n_expr (fndecl, 3,
build1 (ADDR_EXPR, build1 (ADDR_EXPR,
build_pointer_type (unsigned_char_type_node), build_pointer_type (unsigned_char_type_node),
filename), filename),
build_int_cst (NULL_TREE, line_number), line, col);
build_int_cst (NULL_TREE, column_number),
convert (integer_type_node, index),
convert (integer_type_node, first),
convert (integer_type_node, last));
} }
/* Similar to build_call_raise, with extra information about the column /* Similar to build_call_raise_column, for an index or range check exception ,
where the check failed. */ with extra information of the form "INDEX out of range FIRST..LAST". */
tree 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 fndecl = gnat_raise_decls_ext[msg];
tree filename; tree filename, line, col;
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_TYPE (filename) = build_array_type (unsigned_char_type_node, expand_sloc (gnat_node, &filename, &line, &col);
build_index_type (size_int (len)));
return return
build_call_n_expr (fndecl, 3, build_call_n_expr (fndecl, 6,
build1 (ADDR_EXPR, build1 (ADDR_EXPR,
build_pointer_type (unsigned_char_type_node), build_pointer_type (unsigned_char_type_node),
filename), filename),
build_int_cst (NULL_TREE, line_number), line, col,
build_int_cst (NULL_TREE, column_number)); 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 /* qsort comparer for the bit positions of two constructor elements
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment