From patchwork Mon Sep 14 07:20:41 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 517294 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id A7216140134 for ; Mon, 14 Sep 2015 17:22:04 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=yP6BOK9z; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=IDlrl3zJCnZ7Ug2K 39x/QvWGQBYM+zkaw92dQZb9dW2FqKODOVTtraXQZ89uGhAoiJ9Z5fflbo4E2I9t 35bZ+RdZtRJwiG4O7yL+m94bUIjR3gm2Oz8KJM74FSa+NSRMkHGJ90d31YAz8NFr lixx8uU7qbfAEcelDEOYGED1iRY= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=tP780wjX2M7ro9XNlui0Pi zbkJ8=; b=yP6BOK9zwE4OlV78bqViSTf4V/ScjeJXzKHz5CaRaFW4JVHJ0aa1eM lzc1pJKJoWe/JE63nKsyF/ycWxwU32wPRkNmldPMP/9OEasfOUFZRr0EwtL3qif6 76NljxWH+ZThQUih6zqUDGMalf0Ncy5izDPRtvmY0cmbKQUydQmKk= Received: (qmail 85751 invoked by alias); 14 Sep 2015 07:21:55 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 85732 invoked by uid 89); 14 Sep 2015 07:21:54 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.0 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Mon, 14 Sep 2015 07:21:51 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B62D629D22F0 for ; Mon, 14 Sep 2015 09:21:48 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Ho0Hk02XC_AT for ; Mon, 14 Sep 2015 09:21:48 +0200 (CEST) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 6663E29D22CF for ; Mon, 14 Sep 2015 09:21:48 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Housekeeping work in gigi Date: Mon, 14 Sep 2015 09:20:41 +0200 Message-ID: <16208966.oB0o1XNJfG@polaris> User-Agent: KMail/4.7.2 (Linux/3.1.10-1.29-desktop; KDE/4.7.2; x86_64; ; ) MIME-Version: 1.0 No functional changes, tested on x86_64-suse-linux, applied on the mainline. 2015-09-14 Eric Botcazou * 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. Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 227729) +++ gcc-interface/utils.c (working copy) @@ -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", Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 227729) +++ gcc-interface/decl.c (working copy) @@ -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))) Index: gcc-interface/utils2.c =================================================================== --- gcc-interface/utils2.c (revision 227735) +++ gcc-interface/utils2.c (working copy) @@ -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 Index: gcc-interface/gigi.h =================================================================== --- gcc-interface/gigi.h (revision 227729) +++ gcc-interface/gigi.h (working copy) @@ -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 *v); Index: gcc-interface/trans.c =================================================================== --- gcc-interface/trans.c (revision 227729) +++ gcc-interface/trans.c (working copy) @@ -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 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 Index: gcc-interface/misc.c =================================================================== --- gcc-interface/misc.c (revision 227729) +++ gcc-interface/misc.c (working copy) @@ -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