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

gcc/ada/ChangeLog

 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.
 

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

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

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

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",

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