+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.
/* 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;
/* Remove the trailing ";". */
if (result[0] != 0)
result[strlen (result) - 1] = 0;
-
#endif
+
return result;
}
#if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
|| (length > 1 && ISALPHA (name[0]) && name[1] == ':')
#endif
- );
+ );
#endif
}
/* 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;
}
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)
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);
}
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;
/* 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
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;
}
/* 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
}
/* 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;
{
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);
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;
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);
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
{
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;
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.
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,
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;
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 :=
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,
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;
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;
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 :=
#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
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. */
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
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,
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;
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;
pragma Compiler_Unit;
+with System.Concat_2;
+
package body System.Concat_3 is
pragma Suppress (All_Checks);
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;
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;
pragma Compiler_Unit;
+with System.Concat_3;
+
package body System.Concat_4 is
pragma Suppress (All_Checks);
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;
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;
pragma Compiler_Unit;
+with System.Concat_4;
+
package body System.Concat_5 is
pragma Suppress (All_Checks);
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;
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;
pragma Compiler_Unit;
+with System.Concat_5;
+
package body System.Concat_6 is
pragma Suppress (All_Checks);
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;
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;
pragma Compiler_Unit;
+with System.Concat_6;
+
package body System.Concat_7 is
pragma Suppress (All_Checks);
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;
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;
pragma Compiler_Unit;
+with System.Concat_7;
+
package body System.Concat_8 is
pragma Suppress (All_Checks);
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;
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;
pragma Compiler_Unit;
+with System.Concat_8;
+
package body System.Concat_9 is
pragma Suppress (All_Checks);
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;
(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;
projects / thirdparty / gcc.git / commitdiff
