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/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, &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,8 +9508,7 @@ 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));
@@ -9535,46 +9520,25 @@ Sloc_to_locus1 (Source_Ptr Sloc, location_t *locus, bool clear_column)
 
   /* 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;
 }
 
-/* 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.  */
@@ -9610,6 +9574,65 @@ set_gnu_expr_location_from_node (tree node, Node_Id gnat_node)
     }
 }
 
+/* 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

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