[multiple changes]

2009-04-20  Robert Dewar  <dewar@adacore.com>

	* s-conca5.adb, s-conca5.ads, s-conca7.adb, s-conca7.ads, s-conca9.adb,
	s-conca9.ads, rtsfind.ads, s-conca2.adb, s-conca2.ads, s-conca4.adb,
	s-conca4.ads, s-conca6.adb, s-conca6.ads, s-conca8.adb, s-conca8.ads,
	s-conca3.adb, s-conca3.ads (Str_Concat_Bounds_x): New functions.

	* exp_ch4.adb (Expand_Concatenate): Minor code reorganization

2009-04-20  Pascal Obry  <obry@adacore.com>

	* initialize.c (__gnat_initialize): Add braces to kill warning.

	* adaint.c: Minor reformatting, untabify, remove trailing spaces.

From-SVN: r146379

gcc/ada/ChangeLog

+2009-04-20  Robert Dewar  <dewar@adacore.com>
+
+	* s-conca5.adb, s-conca5.ads, s-conca7.adb, s-conca7.ads, s-conca9.adb,
+	s-conca9.ads, rtsfind.ads, s-conca2.adb, s-conca2.ads, s-conca4.adb,
+	s-conca4.ads, s-conca6.adb, s-conca6.ads, s-conca8.adb, s-conca8.ads,
+	s-conca3.adb, s-conca3.ads (Str_Concat_Bounds_x): New functions.
+
+	* exp_ch4.adb (Expand_Concatenate): Minor code reorganization
+
+2009-04-20  Pascal Obry  <obry@adacore.com>
+
+	* initialize.c (__gnat_initialize): Add braces to kill warning.
+
+	* adaint.c: Minor reformatting, untabify, remove trailing spaces.
+
+
 2009-04-17  Arnaud Charlet  <charlet@adacore.com>
 
 	* gcc-interface/Make-lang.in: Update dependencies.

gcc/ada/adaint.c

@@ -1611,6 +1611,7 @@ __gnat_get_libraries_from_registry (void)
 
   /* If the key exists, read out all the values in it and concatenate them
      into a path.  */
+
   for (index = 0; res == ERROR_SUCCESS; index++)
     {
       value_size = name_size = 256;
@@ -1631,8 +1632,8 @@ __gnat_get_libraries_from_registry (void)
   /* Remove the trailing ";".  */
   if (result[0] != 0)
     result[strlen (result) - 1] = 0;
-
 #endif
+
   return result;
 }
 
@@ -1722,7 +1723,7 @@ __gnat_is_absolute_path (char *name, int length)
 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
       || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
 #endif
-	  );
+          );
 #endif
 }
 
@@ -1773,34 +1774,34 @@ GetDriveTypeFromPath (TCHAR *wfullpath)
 
       /* Is this a relative path, if so get current drive type. */
       if (wpath[0] != _T('\\') ||
-	  (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
-	return GetDriveType (NULL);
+          (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
+        return GetDriveType (NULL);
 
       UINT result = GetDriveType (wpath);
 
       /* Cannot guess the drive type, is this \\.\ ? */
 
       if (result == DRIVE_NO_ROOT_DIR &&
-	 _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
-	  && wpath[2] == _T('.') && wpath[3] == _T('\\'))
-	{
-	  if (_tcslen (wpath) == 4)
-	    _tcscat (wpath, wfilename);
-
-	  LPTSTR p = &wpath[4];
-	  LPTSTR b = _tcschr (p, _T('\\'));
-
-	  if (b != NULL)
-	    { /* logical drive \\.\c\dir\file */
-	      *b++ = _T(':');
-	      *b++ = _T('\\');
-	      *b = _T('\0');
-	    }
-	  else
-	    _tcscat (p, _T(":\\"));
-
-	  return GetDriveType (p);
-	}
+         _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
+          && wpath[2] == _T('.') && wpath[3] == _T('\\'))
+        {
+          if (_tcslen (wpath) == 4)
+            _tcscat (wpath, wfilename);
+
+          LPTSTR p = &wpath[4];
+          LPTSTR b = _tcschr (p, _T('\\'));
+
+          if (b != NULL)
+            { /* logical drive \\.\c\dir\file */
+              *b++ = _T(':');
+              *b++ = _T('\\');
+              *b = _T('\0');
+            }
+          else
+            _tcscat (p, _T(":\\"));
+
+          return GetDriveType (p);
+        }
 
       return result;
     }
@@ -1900,9 +1901,9 @@ __gnat_set_OWNER_ACL
   if (AccessMode == SET_ACCESS)
     {
       /*  SET_ACCESS, we want to set an explicte set of permissions, do not
-	  merge with current DACL.  */
+          merge with current DACL.  */
       if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
-	return;
+        return;
     }
   else
     if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
@@ -1973,8 +1974,8 @@ __gnat_is_writable_file (char *name)
       GenericMapping.GenericWrite = GENERIC_WRITE;
 
       return __gnat_check_OWNER_ACL
-	(wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
-	&& !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
+        (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
+        && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
     }
   else
     return !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
@@ -2008,7 +2009,7 @@ __gnat_is_executable_file (char *name)
     }
   else
     return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
-      && _tcsstr (wname, _T(".exe")) - wname == (_tcslen (wname) - 4);
+      && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
 
 #else
   int ret;
@@ -2207,9 +2208,9 @@ __gnat_portable_spawn (char *args[])
       /* The child. */
       if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
 #if defined (VMS)
-	return -1; /* execv is in parent context on VMS.  */
+        return -1; /* execv is in parent context on VMS.  */
 #else
-	_exit (1);
+        _exit (1);
 #endif
     }
 #endif
@@ -2327,9 +2328,9 @@ remove_handle (HANDLE h)
       if (pl->h == h)
         {
           if (pl == PLIST)
-	    PLIST = pl->next;
+            PLIST = pl->next;
           else
-	    prev->next = pl->next;
+            prev->next = pl->next;
           free (pl);
           break;
         }
@@ -2504,9 +2505,9 @@ __gnat_portable_no_block_spawn (char *args[])
       /* The child.  */
       if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
 #if defined (VMS)
-	return -1; /* execv is in parent context on VMS. */
+        return -1; /* execv is in parent context on VMS. */
 #else
-	_exit (1);
+        _exit (1);
 #endif
     }
 
@@ -2616,17 +2617,17 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
       /* Skip the starting quote */
 
       if (*path_val == '"')
-	path_val++;
+        path_val++;
 
       for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
-	*ptr++ = *path_val++;
+        *ptr++ = *path_val++;
 
       ptr--;
 
       /* Skip the ending quote */
 
       if (*ptr == '"')
-	ptr--;
+        ptr--;
 
       if (*ptr != '/' && *ptr != DIR_SEPARATOR)
         *++ptr = DIR_SEPARATOR;
@@ -2754,8 +2755,8 @@ wildcard_translate_unix (char *name)
     {
       new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
       new_canonical_filelist = (char **) xrealloc
-	(new_canonical_filelist,
-	 new_canonical_filelist_allocated * sizeof (char *));
+        (new_canonical_filelist,
+         new_canonical_filelist_allocated * sizeof (char *));
     }
 
   new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
@@ -2791,11 +2792,11 @@ __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
       char *ext;
 
       for (i = 0; i < new_canonical_filelist_in_use; i++)
-	{
-	  ext = strstr (new_canonical_filelist[i], ".dir");
-	  if (ext)
-	    *ext = 0;
-	}
+        {
+          ext = strstr (new_canonical_filelist[i], ".dir");
+          if (ext)
+            *ext = 0;
+        }
     }
 
   return new_canonical_filelist_in_use;
@@ -2974,21 +2975,21 @@ __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
       char *dirspec1;
 
       if (strchr (dirspec, ']') || strchr (dirspec, ':'))
-	{
-	  strncpy (new_canonical_dirspec,
-		   __gnat_translate_vms (dirspec),
-		   MAXPATH);
-	}
+        {
+          strncpy (new_canonical_dirspec,
+                   __gnat_translate_vms (dirspec),
+                   MAXPATH);
+        }
       else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
-	{
-	  strncpy (new_canonical_dirspec,
-		  __gnat_translate_vms (dirspec1),
-		  MAXPATH);
-	}
+        {
+          strncpy (new_canonical_dirspec,
+                  __gnat_translate_vms (dirspec1),
+                  MAXPATH);
+        }
       else
-	{
-	  strncpy (new_canonical_dirspec, dirspec, MAXPATH);
-	}
+        {
+          strncpy (new_canonical_dirspec, dirspec, MAXPATH);
+        }
     }
 
   len = strlen (new_canonical_dirspec);
@@ -3019,16 +3020,16 @@ __gnat_to_canonical_file_spec (char *filespec)
       char *tspec = (char *) __gnat_translate_vms (filespec);
 
       if (tspec != (char *) -1)
-	strncpy (new_canonical_filespec, tspec, MAXPATH);
+        strncpy (new_canonical_filespec, tspec, MAXPATH);
     }
   else if ((strlen (filespec) == strspn (filespec,
-	    "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
-	&& (filespec1 = getenv (filespec)))
+            "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
+        && (filespec1 = getenv (filespec)))
     {
       char *tspec = (char *) __gnat_translate_vms (filespec1);
 
       if (tspec != (char *) -1)
-	strncpy (new_canonical_filespec, tspec, MAXPATH);
+        strncpy (new_canonical_filespec, tspec, MAXPATH);
     }
   else
     {
@@ -3085,11 +3086,11 @@ __gnat_to_canonical_path_spec (char *pathspec)
                 strncat (new_canonical_pathspec, ":", MAXPATH);
             }
 
-	  __gnat_to_canonical_file_list_free ();
+          __gnat_to_canonical_file_list_free ();
         }
       else
-	strncat (new_canonical_pathspec,
-		__gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
+        strncat (new_canonical_pathspec,
+                __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
 
       if (*next == 0)
         break;

gcc/ada/exp_ch4.adb

@@ -2239,6 +2239,14 @@ package body Exp_Ch4 is
       Result : Node_Id;
       --  Result of the concatenation (of type Ityp)
 
+      Actions : constant List_Id := New_List;
+      --  Collect actions to be inserted if Save_Space is False
+
+      Save_Space : Boolean;
+      pragma Warnings (Off, Save_Space);
+      --  Set to True if we are saving generated code space by calling routines
+      --  in packages System.Concat_n.
+
       Known_Non_Null_Operand_Seen : Boolean;
       --  Set True during generation of the assignements of operands into
       --  result once an operand known to be non-null has been seen.
@@ -2552,7 +2560,7 @@ package body Exp_Ch4 is
                  Make_Defining_Identifier (Loc,
                    Chars => New_Internal_Name ('L'));
 
-               Insert_Action (Cnode,
+               Append_To (Actions,
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Var_Length (NN),
                    Constant_Present    => True,
@@ -2564,9 +2572,7 @@ package body Exp_Ch4 is
                      Make_Attribute_Reference (Loc,
                        Prefix         =>
                          Duplicate_Subexpr (Opnd, Name_Req => True),
-                       Attribute_Name => Name_Length)),
-
-                 Suppress => All_Checks);
+                       Attribute_Name => Name_Length)));
             end if;
          end if;
 
@@ -2595,8 +2601,8 @@ package body Exp_Ch4 is
               Make_Integer_Literal (Loc,
                 Intval => Fixed_Length (NN) + Intval (Aggr_Length (NN - 1)));
 
-            --  All other cases, construct an addition node for the length and
-            --  create an entity initialized to this length.
+         --  All other cases, construct an addition node for the length and
+         --  create an entity initialized to this length.
 
          else
             Ent :=
@@ -2609,7 +2615,7 @@ package body Exp_Ch4 is
                Clen := New_Reference_To (Var_Length (NN), Loc);
             end if;
 
-            Insert_Action (Cnode,
+            Append_To (Actions,
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Ent,
                 Constant_Present    => True,
@@ -2620,9 +2626,7 @@ package body Exp_Ch4 is
                 Expression          =>
                   Make_Op_Add (Loc,
                     Left_Opnd  => New_Copy (Aggr_Length (NN - 1)),
-                    Right_Opnd => Clen)),
-
-              Suppress => All_Checks);
+                    Right_Opnd => Clen)));
 
             Aggr_Length (NN) := Make_Identifier (Loc, Chars => Chars (Ent));
          end if;
@@ -2724,13 +2728,12 @@ package body Exp_Ch4 is
             Ent :=
               Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('L'));
 
-            Insert_Action (Cnode,
+            Append_To (Actions,
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Ent,
                 Constant_Present    => True,
                 Object_Definition   => New_Occurrence_Of (Ityp, Loc),
-                Expression          => Get_Known_Bound (1)),
-              Suppress => All_Checks);
+                Expression          => Get_Known_Bound (1)));
 
             Low_Bound := New_Reference_To (Ent, Loc);
          end;
@@ -2773,6 +2776,10 @@ package body Exp_Ch4 is
                High_Bound));
       end if;
 
+      --  Here is where we insert the saved up actions
+
+      Insert_Actions (Cnode, Actions, Suppress => All_Checks);
+
       --  Now we construct an array object with appropriate bounds
 
       Ent :=

gcc/ada/initialize.c

@@ -97,7 +97,7 @@ append_arg (int *index, LPWSTR value, char ***argv, int *last)
 #endif
 
 void
-__gnat_initialize (void *eh)
+__gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 {
    /* Initialize floating-point coprocessor. This call is needed because
       the MS libraries default to 64-bit precision instead of 80-bit
@@ -114,10 +114,12 @@ __gnat_initialize (void *eh)
      CurrentCodePage = CP_UTF8;
 
      if (codepage != NULL)
-       if (strcmp (codepage, "CP_ACP") == 0)
-         CurrentCodePage = CP_ACP;
-       else if (strcmp (codepage, "CP_UTF8") == 0)
-         CurrentCodePage = CP_UTF8;
+       {
+	 if (strcmp (codepage, "CP_ACP") == 0)
+	   CurrentCodePage = CP_ACP;
+	 else if (strcmp (codepage, "CP_UTF8") == 0)
+	   CurrentCodePage = CP_UTF8;
+       }
    }
 
    /* Adjust gnat_argv to support Unicode characters. */

gcc/ada/rtsfind.ads

@@ -705,6 +705,15 @@ package Rtsfind is
      RE_Str_Concat_8,                    -- System.Concat_8
      RE_Str_Concat_9,                    -- System.Concat_9
 
+     RE_Str_Concat_Bounds_2,             -- System.Concat_2
+     RE_Str_Concat_Bounds_3,             -- System.Concat_3
+     RE_Str_Concat_Bounds_4,             -- System.Concat_4
+     RE_Str_Concat_Bounds_5,             -- System.Concat_5
+     RE_Str_Concat_Bounds_6,             -- System.Concat_6
+     RE_Str_Concat_Bounds_7,             -- System.Concat_7
+     RE_Str_Concat_Bounds_8,             -- System.Concat_8
+     RE_Str_Concat_Bounds_9,             -- System.Concat_9
+
      RE_Get_Active_Partition_Id,         -- System.DSA_Services
      RE_Get_Local_Partition_Id,          -- System.DSA_Services
      RE_Get_Passive_Partition_Id,        -- System.DSA_Services
@@ -1858,6 +1867,15 @@ package Rtsfind is
      RE_Str_Concat_8                     => System_Concat_8,
      RE_Str_Concat_9                     => System_Concat_9,
 
+     RE_Str_Concat_Bounds_2              => System_Concat_2,
+     RE_Str_Concat_Bounds_3              => System_Concat_3,
+     RE_Str_Concat_Bounds_4              => System_Concat_4,
+     RE_Str_Concat_Bounds_5              => System_Concat_5,
+     RE_Str_Concat_Bounds_6              => System_Concat_6,
+     RE_Str_Concat_Bounds_7              => System_Concat_7,
+     RE_Str_Concat_Bounds_8              => System_Concat_8,
+     RE_Str_Concat_Bounds_9              => System_Concat_9,
+
      RE_Get_Active_Partition_Id          => System_DSA_Services,
      RE_Get_Local_Partition_Id           => System_DSA_Services,
      RE_Get_Passive_Partition_Id         => System_DSA_Services,

gcc/ada/s-conca2.adb

@@ -52,4 +52,22 @@ package body System.Concat_2 is
       R (F .. L) := S2;
    end Str_Concat_2;
 
+   -------------------------
+   -- Str_Concat_Bounds_2 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_2
+     (Lo, Hi : out Natural;
+      S1, S2 : String)
+   is
+   begin
+      if S1 = "" then
+         Lo := S2'First;
+         Hi := S2'Last;
+      else
+         Lo := S1'First;
+         Hi := S1'Last + S2'Length;
+      end if;
+   end Str_Concat_Bounds_2;
+
 end System.Concat_2;

gcc/ada/s-conca2.ads

@@ -38,8 +38,15 @@ package System.Concat_2 is
 
    procedure Str_Concat_2 (R : out String; S1, S2 : String);
    --  Performs the operation R := S1 & S2. The bounds of R are known to be
-   --  correct, so no bounds checks are required, and it is known that none
-   --  of the input operands overlaps R. No assumptions can be made about
-   --  the lower bounds of any of the operands.
+   --  correct (usually set by a call to the Str_Concat_Bounds_2 procedure
+   --  below), so no bounds checks are required, and it is known that none of
+   --  the input operands overlaps R. No assumptions can be made about the
+   --  lower bounds of any of the operands.
+
+   procedure Str_Concat_Bounds_2
+     (Lo, Hi : out Natural;
+      S1, S2 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the two
+   --  given strings, following the rules in the RM regarding null operands.
 
 end System.Concat_2;

gcc/ada/s-conca3.adb

@@ -31,6 +31,8 @@
 
 pragma Compiler_Unit;
 
+with System.Concat_2;
+
 package body System.Concat_3 is
 
    pragma Suppress (All_Checks);
@@ -56,4 +58,21 @@ package body System.Concat_3 is
       R (F .. L) := S3;
    end Str_Concat_3;
 
+   -------------------------
+   -- Str_Concat_Bounds_3 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_3
+     (Lo, Hi     : out Natural;
+      S1, S2, S3 : String)
+   is
+   begin
+      System.Concat_2.Str_Concat_Bounds_2 (Lo, Hi, S2, S3);
+
+      if S1 /= "" then
+         Hi := S1'Last + Hi - Lo + 1;
+         Lo := S1'First;
+      end if;
+   end Str_Concat_Bounds_3;
+
 end System.Concat_3;

gcc/ada/s-conca3.ads

@@ -38,8 +38,15 @@ package System.Concat_3 is
 
    procedure Str_Concat_3 (R : out String; S1, S2, S3 : String);
    --  Performs the operation R := S1 & S2 & S3. The bounds of R are known to
-   --  be correct, so no bounds checks are required, and it is known that none
-   --  of the input operands overlaps R. No assumptions can be made about
-   --  the lower bounds of any of the operands.
+   --  be correct (usually set by a call to the Str_Concat_Bounds_3 procedure
+   --  below), so no bounds checks are required, and it is known that none of
+   --  the input operands overlaps R. No assumptions can be made about the
+   --  lower bounds of any of the operands.
+
+   procedure Str_Concat_Bounds_3
+     (Lo, Hi     : out Natural;
+      S1, S2, S3 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the three
+   --  given strings, following the rules in the RM regarding null operands.
 
 end System.Concat_3;

gcc/ada/s-conca4.adb

@@ -31,6 +31,8 @@
 
 pragma Compiler_Unit;
 
+with System.Concat_3;
+
 package body System.Concat_4 is
 
    pragma Suppress (All_Checks);
@@ -60,4 +62,21 @@ package body System.Concat_4 is
       R (F .. L) := S4;
    end Str_Concat_4;
 
+   -------------------------
+   -- Str_Concat_Bounds_4 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_4
+     (Lo, Hi         : out Natural;
+      S1, S2, S3, S4 : String)
+   is
+   begin
+      System.Concat_3.Str_Concat_Bounds_3 (Lo, Hi, S2, S3, S4);
+
+      if S1 /= "" then
+         Hi := S1'Last + Hi - Lo + 1;
+         Lo := S1'First;
+      end if;
+   end Str_Concat_Bounds_4;
+
 end System.Concat_4;

gcc/ada/s-conca4.ads

@@ -37,9 +37,16 @@ pragma Compiler_Unit;
 package System.Concat_4 is
 
    procedure Str_Concat_4 (R : out String; S1, S2, S3, S4 : String);
-   --  Performs the operation R := S1 & S2 & S3 & S4. The bounds of R are known
-   --  to be correct, so no bounds checks are required, and it is known that
-   --  none of the input operands overlaps R. No assumptions can be made about
-   --  the lower bounds of any of the operands.
+   --  Performs the operation R := S1 & S2 & S3 & S4. The bounds
+   --  of R are known to be correct (usually set by a call to the
+   --  Str_Concat_Bounds_5 procedure below), so no bounds checks are required,
+   --  and it is known that none of the input operands overlaps R. No
+   --  assumptions can be made about the lower bounds of any of the operands.
+
+   procedure Str_Concat_Bounds_4
+     (Lo, Hi         : out Natural;
+      S1, S2, S3, S4 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the four
+   --  given strings, following the rules in the RM regarding null operands.
 
 end System.Concat_4;

gcc/ada/s-conca5.adb

@@ -31,6 +31,8 @@
 
 pragma Compiler_Unit;
 
+with System.Concat_4;
+
 package body System.Concat_5 is
 
    pragma Suppress (All_Checks);
@@ -64,4 +66,21 @@ package body System.Concat_5 is
       R (F .. L) := S5;
    end Str_Concat_5;
 
+   -------------------------
+   -- Str_Concat_Bounds_5 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_5
+     (Lo, Hi             : out Natural;
+      S1, S2, S3, S4, S5 : String)
+   is
+   begin
+      System.Concat_4.Str_Concat_Bounds_4 (Lo, Hi, S2, S3, S4, S5);
+
+      if S1 /= "" then
+         Hi := S1'Last + Hi - Lo + 1;
+         Lo := S1'First;
+      end if;
+   end Str_Concat_Bounds_5;
+
 end System.Concat_5;

gcc/ada/s-conca5.ads

@@ -37,9 +37,16 @@ pragma Compiler_Unit;
 package System.Concat_5 is
 
    procedure Str_Concat_5 (R : out String; S1, S2, S3, S4, S5 : String);
-   --  Performs the operation R := S1 & S2 & S3 & S4 & S5. The bounds of R are
-   --  known to be correct, so no bounds checks are required, and it is known
-   --  that none of the input operands overlaps R. No assumptions can be made
-   --  about the lower bounds of any of the operands.
+   --  Performs the operation R := S1 & S2 & S3 & S4 & S5. The bounds
+   --  of R are known to be correct (usually set by a call to the
+   --  Str_Concat_Bounds_5 procedure below), so no bounds checks are required,
+   --  and it is known that none of the input operands overlaps R. No
+   --  assumptions can be made about the lower bounds of any of the operands.
+
+   procedure Str_Concat_Bounds_5
+     (Lo, Hi             : out Natural;
+      S1, S2, S3, S4, S5 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the five
+   --  given strings, following the rules in the RM regarding null operands.
 
 end System.Concat_5;

gcc/ada/s-conca6.adb

@@ -31,6 +31,8 @@
 
 pragma Compiler_Unit;
 
+with System.Concat_5;
+
 package body System.Concat_6 is
 
    pragma Suppress (All_Checks);
@@ -68,4 +70,21 @@ package body System.Concat_6 is
       R (F .. L) := S6;
    end Str_Concat_6;
 
+   -------------------------
+   -- Str_Concat_Bounds_6 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_6
+     (Lo, Hi                 : out Natural;
+      S1, S2, S3, S4, S5, S6 : String)
+   is
+   begin
+      System.Concat_5.Str_Concat_Bounds_5 (Lo, Hi, S2, S3, S4, S5, S6);
+
+      if S1 /= "" then
+         Hi := S1'Last + Hi - Lo + 1;
+         Lo := S1'First;
+      end if;
+   end Str_Concat_Bounds_6;
+
 end System.Concat_6;

gcc/ada/s-conca6.ads

@@ -37,9 +37,16 @@ pragma Compiler_Unit;
 package System.Concat_6 is
 
    procedure Str_Concat_6 (R : out String; S1, S2, S3, S4, S5, S6 : String);
-   --  Performs the operation R := S1 & S2 & S3 & S4 & S5 & S6. The bounds of
-   --  R are known to be correct, so no bounds checks are required, and it is
-   --  known that none of the input operands overlaps R. No assumptions can be
-   --  made about the lower bounds of any of the operands.
+   --  Performs the operation R := S1 & S2 & S3 & S4 & S5 & S6. The
+   --  bounds of R are known to be correct (usually set by a call to the
+   --  Str_Concat_Bounds_6 procedure below), so no bounds checks are required,
+   --  and it is known that none of the input operands overlaps R. No
+   --  assumptions can be made about the lower bounds of any of the operands.
+
+   procedure Str_Concat_Bounds_6
+     (Lo, Hi                 : out Natural;
+      S1, S2, S3, S4, S5, S6 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the six
+   --  given strings, following the rules in the RM regarding null operands.
 
 end System.Concat_6;

gcc/ada/s-conca7.adb

@@ -31,6 +31,8 @@
 
 pragma Compiler_Unit;
 
+with System.Concat_6;
+
 package body System.Concat_7 is
 
    pragma Suppress (All_Checks);
@@ -75,4 +77,21 @@ package body System.Concat_7 is
       R (F .. L) := S7;
    end Str_Concat_7;
 
+   -------------------------
+   -- Str_Concat_Bounds_7 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_7
+     (Lo, Hi                     : out Natural;
+      S1, S2, S3, S4, S5, S6, S7 : String)
+   is
+   begin
+      System.Concat_6.Str_Concat_Bounds_6 (Lo, Hi, S2, S3, S4, S5, S6, S7);
+
+      if S1 /= "" then
+         Hi := S1'Last + Hi - Lo + 1;
+         Lo := S1'First;
+      end if;
+   end Str_Concat_Bounds_7;
+
 end System.Concat_7;

gcc/ada/s-conca7.ads

@@ -39,9 +39,16 @@ package System.Concat_7 is
    procedure Str_Concat_7
      (R                          : out String;
       S1, S2, S3, S4, S5, S6, S7 : String);
-   --  Performs the operation R := S1 & S2 & S3 & S4 & S5 & S6 & S7. The bounds
-   --  of R are known to be correct, so no bounds checks are required, and it
-   --  is known that none of the input operands overlaps R. No assumptions can
-   --  be made about the lower bounds of any of the operands.
+   --  Performs the operation R := S1 & S2 & S3 & S4 & S5 & S6 & S7. The
+   --  bounds of R are known to be correct (usually set by a call to the
+   --  Str_Concat_Bounds_8 procedure below), so no bounds checks are required,
+   --  and it is known that none of the input operands overlaps R. No
+   --  assumptions can be made about the lower bounds of any of the operands.
+
+   procedure Str_Concat_Bounds_7
+     (Lo, Hi                     : out Natural;
+      S1, S2, S3, S4, S5, S6, S7 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the seven
+   --  given strings, following the rules in the RM regarding null operands.
 
 end System.Concat_7;

gcc/ada/s-conca8.adb

@@ -31,6 +31,8 @@
 
 pragma Compiler_Unit;
 
+with System.Concat_7;
+
 package body System.Concat_8 is
 
    pragma Suppress (All_Checks);
@@ -79,4 +81,22 @@ package body System.Concat_8 is
       R (F .. L) := S8;
    end Str_Concat_8;
 
+   -------------------------
+   -- Str_Concat_Bounds_8 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_8
+     (Lo, Hi                         : out Natural;
+      S1, S2, S3, S4, S5, S6, S7, S8 : String)
+   is
+   begin
+      System.Concat_7.Str_Concat_Bounds_7
+        (Lo, Hi, S2, S3, S4, S5, S6, S7, S8);
+
+      if S1 /= "" then
+         Hi := S1'Last + Hi - Lo + 1;
+         Lo := S1'First;
+      end if;
+   end Str_Concat_Bounds_8;
+
 end System.Concat_8;

gcc/ada/s-conca8.ads

@@ -39,9 +39,16 @@ package System.Concat_8 is
    procedure Str_Concat_8
      (R                              : out String;
       S1, S2, S3, S4, S5, S6, S7, S8 : String);
-   --  Performs the operation R := S1 & S2 & S3 & S4 & S5 & S6 & S7 & S8. The
-   --  bounds of R are known to be correct, so no bounds checks are required,
+   --  Performs the operation R := S1 & S2 & S3 & S4 & S5 & S6 & S7 & S8.
+   --  The bounds of R are known to be correct (usually set by a call to the
+   --  Str_Concat_Bounds_8 procedure below), so no bounds checks are required,
    --  and it is known that none of the input operands overlaps R. No
    --  assumptions can be made about the lower bounds of any of the operands.
 
+   procedure Str_Concat_Bounds_8
+     (Lo, Hi                         : out Natural;
+      S1, S2, S3, S4, S5, S6, S7, S8 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the eight
+   --  given strings, following the rules in the RM regarding null operands.
+
 end System.Concat_8;

gcc/ada/s-conca9.adb

@@ -31,6 +31,8 @@
 
 pragma Compiler_Unit;
 
+with System.Concat_8;
+
 package body System.Concat_9 is
 
    pragma Suppress (All_Checks);
@@ -83,4 +85,22 @@ package body System.Concat_9 is
       R (F .. L) := S9;
    end Str_Concat_9;
 
+   -------------------------
+   -- Str_Concat_Bounds_9 --
+   -------------------------
+
+   procedure Str_Concat_Bounds_9
+     (Lo, Hi                             : out Natural;
+      S1, S2, S3, S4, S5, S6, S7, S8, S9 : String)
+   is
+   begin
+      System.Concat_8.Str_Concat_Bounds_8
+        (Lo, Hi, S2, S3, S4, S5, S6, S7, S8, S9);
+
+      if S1 /= "" then
+         Hi := S1'Last + Hi - Lo + 1;
+         Lo := S1'First;
+      end if;
+   end Str_Concat_Bounds_9;
+
 end System.Concat_9;

gcc/ada/s-conca9.ads

@@ -40,8 +40,15 @@ package System.Concat_9 is
      (R                                  : out String;
       S1, S2, S3, S4, S5, S6, S7, S8, S9 : String);
    --  Performs the operation R := S1 & S2 & S3 & S4 & S5 & S6 & S7 & S8 & S9.
-   --  The bounds of R are known to be correct, so no bounds checks are
-   --  required, and it is known that none of the input operands overlaps R. No
+   --  The bounds of R are known to be correct (usually set by a call to the
+   --  Str_Concat_Bounds_9 procedure below), so no bounds checks are required,
+   --  and it is known that none of the input operands overlaps R. No
    --  assumptions can be made about the lower bounds of any of the operands.
 
+   procedure Str_Concat_Bounds_9
+     (Lo, Hi                             : out Natural;
+      S1, S2, S3, S4, S5, S6, S7, S8, S9 : String);
+   --  Assigns to Lo..Hi the bounds of the result of concatenating the nine
+   --  given strings, following the rules in the RM regarding null operands.
+
 end System.Concat_9;