diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2015-09-14 07:21:38 +0000 |
---|---|---|
committer | Eric Botcazou <ebotcazou@gcc.gnu.org> | 2015-09-14 07:21:38 +0000 |
commit | ba4643153b87f84c0ee07ffd7f7fd53589c94ddc (patch) | |
tree | 83fbdae90cd7856085145cac723fa634819cb318 | |
parent | 92d5f5ab3c36e05f10fc3445f0bf4b38e48be8fb (diff) | |
download | gcc-ba4643153b87f84c0ee07ffd7f7fd53589c94ddc.zip gcc-ba4643153b87f84c0ee07ffd7f7fd53589c94ddc.tar.gz gcc-ba4643153b87f84c0ee07ffd7f7fd53589c94ddc.tar.bz2 |
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
-rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.c | 2 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 36 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/misc.c | 2 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.c | 198 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/utils.c | 4 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/utils2.c | 179 |
7 files changed, 189 insertions, 253 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e8276a4..e3d0e22 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,26 @@ 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 another acceptable pattern for the RHS. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 971c066..cb3d778 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -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))) diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 67977b0..9420fd8 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -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); diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 5b2d8b3..9d8d262 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -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 diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 413550a..fea8e15 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -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, ¤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, 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 diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 0032839..f54f2f0 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -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", diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index e5c685b..70737a9 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -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); + } - 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) @@ -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,138 +1824,63 @@ 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)); + 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 |