procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gigi.h (ref_filename): Delete.

Browse source 
* 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
This commit is contained in:
Eric Botcazou 2015-09-14 07:21:38 +00:00 • committed by Eric Botcazou
parent 92d5f5ab3c
commit ba4643153b
7 changed files with 197 additions and 261 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
gcc/ada/ChangeLog
View file

@ -1,3 +1,24 @@
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

2
gcc/ada/gcc-interface/decl.c
View file

@ -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
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)))

36
gcc/ada/gcc-interface/gigi.h
View file

@ -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 *expr_p, gimple_seq *pre_p,
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 result_type, tree stmt_operand,
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);

2
gcc/ada/gcc-interface/misc.c
View file

@ -658,7 +658,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
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

198
gcc/ada/gcc-interface/trans.c
View file

@ -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 (Node_Id gnat_node)
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 gnat_entity)
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, &current_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, location_t *locus, bool clear_column)
*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. */
@ -9609,6 +9573,65 @@ set_gnu_expr_location_from_node (tree node, Node_Id 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;
}
}
/* Return a colon-separated list of encodings contained in encoded Ada
name. */
@ -9679,65 +9702,6 @@ post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int num)
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

4
gcc/ada/gcc-interface/utils.c
View file

@ -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 name, tree ARG_UNUSED (args),
{
if (TREE_CODE (*node) == FUNCTION_DECL)
DECL_PURE_P (*node) = 1;
/* ??? TODO: Support types. */
/* TODO: support types. */
else
{
warning (OPT_Wattributes, "%qs attribute ignored",

195
gcc/ada/gcc-interface/utils2.c
View file

@ -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;
KIND says which kind of exception this is for
(N_Raise_{Constraint,Storage,Program}_Error). */
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);
}
/* 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_node, char kind)
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,91 +1824,21 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
= 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));
}
/* 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". */
tree
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_TYPE (filename) = build_array_type (unsigned_char_type_node,
build_index_type (size_int (len)));
return
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),
convert (integer_type_node, index),
convert (integer_type_node, first),
convert (integer_type_node, last));
line);
}
/* Similar to build_call_raise, with extra information about the column
@ -1886,44 +1848,39 @@ tree
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;
tree filename, line, col;
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,
build_index_type (size_int (len)));
expand_sloc (gnat_node, &filename, &line, &col);
return
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));
line, col);
}
/* 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_range (int msg, Node_Id gnat_node,
tree index, tree first, tree last)
{
tree fndecl = gnat_raise_decls_ext[msg];
tree filename, line, col;
expand_sloc (gnat_node, &filename, &line, &col);
return
build_call_n_expr (fndecl, 6,
build1 (ADDR_EXPR,
build_pointer_type (unsigned_char_type_node),
filename),
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