mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 01:20:52 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2009-04-20 11:14:04 +02:00
parent 34c25b321f
commit d0f8d157fe
21 changed files with 359 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
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.

125
gcc/ada/adaint.c
View File

@ -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);
_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('\\'));
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(":\\"));
if (b != NULL)
{ /* logical drive \\.\c\dir\file */
*b++ = _T(':');
*b++ = _T('\\');
*b = _T('\0');
}
else
_tcscat (p, _T(":\\"));
return GetDriveType (p);
}
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;

33
gcc/ada/exp_ch4.adb
View File

@ -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 :=

12
gcc/ada/initialize.c
View File

@ -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. */

18
gcc/ada/rtsfind.ads
View File

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

18
gcc/ada/s-conca2.adb
View File

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

13
gcc/ada/s-conca2.ads
View File

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

19
gcc/ada/s-conca3.adb
View File

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

13
gcc/ada/s-conca3.ads
View File

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

19
gcc/ada/s-conca4.adb
View File

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

15
gcc/ada/s-conca4.ads
View File

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

19
gcc/ada/s-conca5.adb
View File

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

15
gcc/ada/s-conca5.ads
View File

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

19
gcc/ada/s-conca6.adb
View File

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

15
gcc/ada/s-conca6.ads
View File

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

19
gcc/ada/s-conca7.adb
View File

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

15
gcc/ada/s-conca7.ads
View File

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

20
gcc/ada/s-conca8.adb
View File

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

11
gcc/ada/s-conca8.ads
View File

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

20
gcc/ada/s-conca9.adb
View File

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

11
gcc/ada/s-conca9.ads
View File

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