mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-05 22:11:30 +08:00
[multiple changes]
2004-04-23 Emmanuel Briot <briot@act-europe.fr>
* adaint.c (__gnat_try_lock): No longer requires that the parent
directory be writable, the directory itself is enough.
(gnat_is_absolute_path): Change profile, so that the call from
GNAT.OS_Lib can be made more efficient.
* adaint.h (gnat_is_absolute_path): Change profile, so that the call
from GNAT.OS_Lib can be made more efficient.
* g-os_lib.adb (Is_Absolute_Path): More efficient implementation, avoid
one copy of the file name. Found by code reading.
2004-04-23 Vincent Celier <celier@gnat.com>
* gnat_ugn.texi: Add documentation for gnatmake switch -eL
Correct documentation on gnatmake switches transmitted to the compiler
* ali.ads: Minor comment fix
2004-04-23 Javier Miranda <miranda@gnat.com>
* sem_ch6.adb: (Confirming Types): Code cleanup
* decl.c (gnat_to_gnu_entity): Give support to anonymous access to
subprogram types: E_Anonymous_Access_Subprogram_Type and
E_Anonymous_Access_Protected_Subprogram_Type.
2004-04-23 Thomas Quinot <quinot@act-europe.fr>
* sem_dist.adb: Add a new paramter to the RAS_Access TSS indicating
whether a pragma All_Calls_Remote applies to the subprogram on which
'Access is taken.
No functional change is introduced by this revision; the new parameter
will be used to allow calls to local RCI subprograms to be optimized
to not use the PCS in the case where no pragma All_Calls_Remote applies,
as is already done in the PolyORB implementation of the DSA.
* exp_dist.adb: Add a new paramter to the RAS_Access TSS indicating
whether a pragma All_Calls_Remote applies to the subprogram on which
'Access is taken.
No functional change is introduced by this revision; the new parameter
will be used to allow calls to local RCI subprograms to be optimized
to not use the PCS in the case where no pragma All_Calls_Remote applies,
as is already done in the PolyORB implementation of the DSA.
2004-04-23 Robert Dewar <dewar@gnat.com>
* Makefile.rtl: Add entry for s-addope.o in run time library list
* Make-lang.in: Add entry for s-addope.o to GNAT1 objects
* s-addope.ads, s-addope.adb: New files.
* s-carsi8.adb, s-carun8.adb, s-casi16.adb, s-casi32.adb,
s-casi64.adb, s-caun16.adb, s-caun32.adb, s-caun64.adb,
s-finimp.adb, s-geveop.adb, s-stoele.adb: Modifications to allow
System.Address to be non-private and signed.
* sem_elim.adb: Minor reformatting (fairly extensive)
Some minor code reorganization from code reading
Add a couple of ??? comments
2004-04-23 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* trans.c (tree_transform, build_unit_elab): Don't call getdecls.
(tree_transform, case N_If_Statement): Remove non-determinism.
* utils.c (begin_subprog_body): Just set DECL_CONTEXT in PARM_DECL.
2004-04-23 Sergey Rybin <rybin@act-europe.fr>
* gnat_rm.texi: Small fixes in the changes made in the 'pragma
Eliminate' section.
* snames.ads, snames.adb: Remove Name_Homonym_Number (Homonym_Number is
no longer used as a parameter name for Eliminate pragma).
From-SVN: r81086
This commit is contained in:
Arnaud Charlet
parent
082a635146
commit
cc4f0de1aa
@ -1,3 +1,79 @@
|
||||
2004-04-23 Emmanuel Briot <briot@act-europe.fr>
|
||||
|
||||
* adaint.c (__gnat_try_lock): No longer requires that the parent
|
||||
directory be writable, the directory itself is enough.
|
||||
(gnat_is_absolute_path): Change profile, so that the call from
|
||||
GNAT.OS_Lib can be made more efficient.
|
||||
|
||||
* adaint.h (gnat_is_absolute_path): Change profile, so that the call
|
||||
from GNAT.OS_Lib can be made more efficient.
|
||||
|
||||
* g-os_lib.adb (Is_Absolute_Path): More efficient implementation, avoid
|
||||
one copy of the file name. Found by code reading.
|
||||
|
||||
2004-04-23 Vincent Celier <celier@gnat.com>
|
||||
|
||||
* gnat_ugn.texi: Add documentation for gnatmake switch -eL
|
||||
Correct documentation on gnatmake switches transmitted to the compiler
|
||||
|
||||
* ali.ads: Minor comment fix
|
||||
|
||||
2004-04-23 Javier Miranda <miranda@gnat.com>
|
||||
|
||||
* sem_ch6.adb: (Confirming Types): Code cleanup
|
||||
|
||||
* decl.c (gnat_to_gnu_entity): Give support to anonymous access to
|
||||
subprogram types: E_Anonymous_Access_Subprogram_Type and
|
||||
E_Anonymous_Access_Protected_Subprogram_Type.
|
||||
|
||||
2004-04-23 Thomas Quinot <quinot@act-europe.fr>
|
||||
|
||||
* sem_dist.adb: Add a new paramter to the RAS_Access TSS indicating
|
||||
whether a pragma All_Calls_Remote applies to the subprogram on which
|
||||
'Access is taken.
|
||||
No functional change is introduced by this revision; the new parameter
|
||||
will be used to allow calls to local RCI subprograms to be optimized
|
||||
to not use the PCS in the case where no pragma All_Calls_Remote applies,
|
||||
as is already done in the PolyORB implementation of the DSA.
|
||||
|
||||
* exp_dist.adb: Add a new paramter to the RAS_Access TSS indicating
|
||||
whether a pragma All_Calls_Remote applies to the subprogram on which
|
||||
'Access is taken.
|
||||
No functional change is introduced by this revision; the new parameter
|
||||
will be used to allow calls to local RCI subprograms to be optimized
|
||||
to not use the PCS in the case where no pragma All_Calls_Remote applies,
|
||||
as is already done in the PolyORB implementation of the DSA.
|
||||
|
||||
2004-04-23 Robert Dewar <dewar@gnat.com>
|
||||
|
||||
* Makefile.rtl: Add entry for s-addope.o in run time library list
|
||||
* Make-lang.in: Add entry for s-addope.o to GNAT1 objects
|
||||
* s-addope.ads, s-addope.adb: New files.
|
||||
|
||||
* s-carsi8.adb, s-carun8.adb, s-casi16.adb, s-casi32.adb,
|
||||
s-casi64.adb, s-caun16.adb, s-caun32.adb, s-caun64.adb,
|
||||
s-finimp.adb, s-geveop.adb, s-stoele.adb: Modifications to allow
|
||||
System.Address to be non-private and signed.
|
||||
|
||||
* sem_elim.adb: Minor reformatting (fairly extensive)
|
||||
Some minor code reorganization from code reading
|
||||
Add a couple of ??? comments
|
||||
|
||||
2004-04-23 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
|
||||
|
||||
* trans.c (tree_transform, build_unit_elab): Don't call getdecls.
|
||||
(tree_transform, case N_If_Statement): Remove non-determinism.
|
||||
|
||||
* utils.c (begin_subprog_body): Just set DECL_CONTEXT in PARM_DECL.
|
||||
|
||||
2004-04-23 Sergey Rybin <rybin@act-europe.fr>
|
||||
|
||||
* gnat_rm.texi: Small fixes in the changes made in the 'pragma
|
||||
Eliminate' section.
|
||||
|
||||
* snames.ads, snames.adb: Remove Name_Homonym_Number (Homonym_Number is
|
||||
no longer used as a parameter name for Eliminate pragma).
|
||||
|
||||
2004-04-22 Laurent GUERBY <laurent@guerby.net>
|
||||
|
||||
PR optimization/14984
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -40,6 +40,7 @@ GNATRTL_TASKING_OBJS= \
|
||||
g-semaph$(objext) \
|
||||
g-signal$(objext) \
|
||||
g-thread$(objext) \
|
||||
s-addope$(objext) \
|
||||
s-asthan$(objext) \
|
||||
s-inmaop$(objext) \
|
||||
s-interr$(objext) \
|
||||
|
||||
@ -411,7 +411,8 @@ __gnat_try_lock (char *dir, char *file)
|
||||
int fd;
|
||||
|
||||
sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
|
||||
sprintf (temp_file, "%s-%ld-%ld", dir, (long) getpid(), (long) getppid ());
|
||||
sprintf (temp_file, "%s%cTMP-%ld-%ld",
|
||||
dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
|
||||
|
||||
/* Create the temporary file and write the process number. */
|
||||
fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
|
||||
@ -1404,11 +1405,12 @@ __gnat_file_exists (char *name)
|
||||
}
|
||||
|
||||
int
|
||||
__gnat_is_absolute_path (char *name)
|
||||
__gnat_is_absolute_path (char *name, int length)
|
||||
{
|
||||
return (*name == '/' || *name == DIR_SEPARATOR
|
||||
return (length != 0) &&
|
||||
(*name == '/' || *name == DIR_SEPARATOR
|
||||
#if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
|
||||
|| (strlen (name) > 1 && isalpha (name[0]) && name[1] == ':')
|
||||
|| (length > 1 && isalpha (name[0]) && name[1] == ':')
|
||||
#endif
|
||||
);
|
||||
}
|
||||
@ -1898,7 +1900,7 @@ char *
|
||||
__gnat_locate_regular_file (char *file_name, char *path_val)
|
||||
{
|
||||
char *ptr;
|
||||
int absolute = __gnat_is_absolute_path (file_name);
|
||||
int absolute = __gnat_is_absolute_path (file_name, strlen (file_name));
|
||||
|
||||
/* Handle absolute pathnames. */
|
||||
if (absolute)
|
||||
|
||||
@ -77,7 +77,7 @@ extern void __gnat_get_env_value_ptr (char *, int *,
|
||||
char **);
|
||||
extern int __gnat_file_exists (char *);
|
||||
extern int __gnat_is_regular_file (char *);
|
||||
extern int __gnat_is_absolute_path (char *);
|
||||
extern int __gnat_is_absolute_path (char *,int);
|
||||
extern int __gnat_is_directory (char *);
|
||||
extern int __gnat_is_writable_file (char *);
|
||||
extern int __gnat_is_readable_file (char *name);
|
||||
|
||||
@ -476,7 +476,7 @@ package ALI is
|
||||
-- Indicates presence of ED parameter
|
||||
|
||||
Interface : Boolean := False;
|
||||
-- True if the Unit is an Interface of a Stand-Alole Library
|
||||
-- True if the Unit is an Interface of a Stand-Alone Library
|
||||
|
||||
end record;
|
||||
|
||||
|
||||
@ -2731,6 +2731,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
||||
break;
|
||||
|
||||
case E_Access_Subprogram_Type:
|
||||
case E_Anonymous_Access_Subprogram_Type:
|
||||
/* If we are not defining this entity, and we have incomplete
|
||||
entities being processed above us, make a dummy type and
|
||||
fill it in later. */
|
||||
@ -3047,6 +3048,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
||||
break;
|
||||
|
||||
case E_Access_Protected_Subprogram_Type:
|
||||
case E_Anonymous_Access_Protected_Subprogram_Type:
|
||||
if (type_annotate_only && No (Equivalent_Type (gnat_entity)))
|
||||
gnu_type = build_pointer_type (void_type_node);
|
||||
else
|
||||
|
||||
@ -1200,9 +1200,14 @@ package body Exp_Dist is
|
||||
Param : Node_Id;
|
||||
Package_Name : Node_Id;
|
||||
Subp_Id : Node_Id;
|
||||
Asynchronous : Node_Id;
|
||||
Asynch_P : Node_Id;
|
||||
Return_Value : Node_Id;
|
||||
|
||||
All_Calls_Remote : Entity_Id;
|
||||
-- True if an All_Calls_Remote pragma applies to the RCI unit
|
||||
-- that contains the subprogram (currently unused, all RAS
|
||||
-- dereferences are handled through the PCS).
|
||||
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
|
||||
procedure Set_Field (Field_Name : in Name_Id; Value : in Node_Id);
|
||||
@ -1226,8 +1231,10 @@ package body Exp_Dist is
|
||||
Param := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
|
||||
Package_Name := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
|
||||
Subp_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
|
||||
Asynchronous := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
|
||||
Asynch_P := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
|
||||
Return_Value := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
|
||||
All_Calls_Remote :=
|
||||
Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
|
||||
|
||||
-- Create the object which will be returned of type Fat_Type
|
||||
|
||||
@ -1261,7 +1268,7 @@ package body Exp_Dist is
|
||||
New_Occurrence_Of (Subp_Id, Loc));
|
||||
|
||||
Set_Field (Name_Async,
|
||||
New_Occurrence_Of (Asynchronous, Loc));
|
||||
New_Occurrence_Of (Asynch_P, Loc));
|
||||
|
||||
-- Return the newly created value
|
||||
|
||||
@ -1294,7 +1301,12 @@ package body Exp_Dist is
|
||||
New_Occurrence_Of (Standard_Natural, Loc)),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Asynchronous,
|
||||
Defining_Identifier => Asynch_P,
|
||||
Parameter_Type =>
|
||||
New_Occurrence_Of (Standard_Boolean, Loc)),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => All_Calls_Remote,
|
||||
Parameter_Type =>
|
||||
New_Occurrence_Of (Standard_Boolean, Loc))),
|
||||
|
||||
|
||||
@ -1110,16 +1110,13 @@ package body GNAT.OS_Lib is
|
||||
----------------------
|
||||
|
||||
function Is_Absolute_Path (Name : String) return Boolean is
|
||||
function Is_Absolute_Path (Name : Address) return Integer;
|
||||
function Is_Absolute_Path
|
||||
(Name : Address;
|
||||
Length : Integer) return Integer;
|
||||
pragma Import (C, Is_Absolute_Path, "__gnat_is_absolute_path");
|
||||
|
||||
F_Name : String (1 .. Name'Length + 1);
|
||||
|
||||
begin
|
||||
F_Name (1 .. Name'Length) := Name;
|
||||
F_Name (F_Name'Last) := ASCII.NUL;
|
||||
|
||||
return Is_Absolute_Path (F_Name'Address) /= 0;
|
||||
return Is_Absolute_Path (Name'Address, Name'Length) /= 0;
|
||||
end Is_Absolute_Path;
|
||||
|
||||
------------------
|
||||
|
||||
@ -1362,11 +1362,10 @@ SOURCE_TRACE ::= STRING_LITERAL
|
||||
@end smallexample
|
||||
|
||||
@noindent
|
||||
|
||||
This pragma indicates that the given entity is not used outside the
|
||||
compilation unit it is defined in. The entity an explicitly declared
|
||||
subprogram, including subprogram declared by subprogram instantiations and
|
||||
subprograms declared in package instantiations.
|
||||
compilation unit it is defined in. The entity must be an explicitly declared
|
||||
subprogram; this includes generic subprogram instances and
|
||||
subprograms declared in generic package instances.
|
||||
|
||||
If the entity to be eliminated is a library level subprogram, then
|
||||
the first form of pragma @code{Eliminate} is used with only a single argument.
|
||||
@ -14142,4 +14141,3 @@ environment in which the gnat tool will execute.
|
||||
@contents
|
||||
|
||||
@bye
|
||||
|
||||
|
||||
@ -8157,6 +8157,12 @@ and ALI files go in the current working directory.
|
||||
|
||||
This switch cannot be used when using a project file.
|
||||
|
||||
@ifclear vms
|
||||
@item -eL
|
||||
@cindex @option{-eL} (@code{gnatmake})
|
||||
Follow all symbolic links when processing project files.
|
||||
@end ifclear
|
||||
|
||||
@item ^-f^/FORCE_COMPILE^
|
||||
@cindex @option{^-f^/FORCE_COMPILE^} (@code{gnatmake})
|
||||
Force recompilations. Recompile all sources, even though some object
|
||||
@ -8345,10 +8351,8 @@ linker.
|
||||
@table @asis
|
||||
@item @code{gcc} @asis{switches}
|
||||
@ifclear vms
|
||||
Any uppercase switch (other than @option{-A},
|
||||
@option{-L} or
|
||||
@option{-S}) or any switch that is more than one character is passed to
|
||||
@code{gcc} (e.g. @option{-O}, @option{-gnato,} etc.)
|
||||
Any uppercase or multi-character switch that is not a @code{gnatmake} switch
|
||||
is passed to @code{gcc} (e.g. @option{-O}, @option{-gnato,} etc.)
|
||||
@end ifclear
|
||||
@ifset vms
|
||||
Any qualifier that cannot be recognized as a qualifier for @code{GNAT MAKE}
|
||||
|
||||
114
gcc/ada/s-addope.adb
Normal file
114
gcc/ada/s-addope.adb
Normal file
@ -0,0 +1,114 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . A D D R E S S _ O P E R A T I O N S --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
-- apply solely to the implementation dependent sections of this file. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
||||
-- MA 02111-1307, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Address_Operations is
|
||||
|
||||
type IA is mod 2 ** Address'Size;
|
||||
-- The type used to provide the actual desired operations
|
||||
|
||||
function I is new Unchecked_Conversion (Address, IA);
|
||||
function A is new Unchecked_Conversion (IA, Address);
|
||||
-- The operations are implemented by unchecked conversion to type IA,
|
||||
-- followed by doing the intrinsic operation on the IA values, followed
|
||||
-- by converting the result back to type Address.
|
||||
|
||||
----------
|
||||
-- AddA --
|
||||
----------
|
||||
|
||||
function AddA (Left, Right : Address) return Address is
|
||||
begin
|
||||
return A (I (Left) + I (Right));
|
||||
end AddA;
|
||||
|
||||
----------
|
||||
-- AndA --
|
||||
----------
|
||||
|
||||
function AndA (Left, Right : Address) return Address is
|
||||
begin
|
||||
return A (I (Left) and I (Right));
|
||||
end AndA;
|
||||
|
||||
----------
|
||||
-- DivA --
|
||||
----------
|
||||
|
||||
function DivA (Left, Right : Address) return Address is
|
||||
begin
|
||||
return A (I (Left) / I (Right));
|
||||
end DivA;
|
||||
|
||||
----------
|
||||
-- ModA --
|
||||
----------
|
||||
|
||||
function ModA (Left, Right : Address) return Address is
|
||||
begin
|
||||
return A (I (Left) and I (Right));
|
||||
end ModA;
|
||||
|
||||
---------
|
||||
-- MulA --
|
||||
---------
|
||||
|
||||
function MulA (Left, Right : Address) return Address is
|
||||
begin
|
||||
return A (I (Left) * I (Right));
|
||||
end MulA;
|
||||
|
||||
---------
|
||||
-- OrA --
|
||||
---------
|
||||
|
||||
function OrA (Left, Right : Address) return Address is
|
||||
begin
|
||||
return A (I (Left) or I (Right));
|
||||
end OrA;
|
||||
|
||||
----------
|
||||
-- SubA --
|
||||
----------
|
||||
|
||||
function SubA (Left, Right : Address) return Address is
|
||||
begin
|
||||
return A (I (Left) - I (Right));
|
||||
end SubA;
|
||||
|
||||
end System.Address_Operations;
|
||||
84
gcc/ada/s-addope.ads
Normal file
84
gcc/ada/s-addope.ads
Normal file
@ -0,0 +1,84 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . A D D R E S S _ O P E R A T I O N S --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
-- apply solely to the implementation dependent sections of this file. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
||||
-- MA 02111-1307, USA. --
|
||||
-- --
|
||||
-- As a special exception, if other files instantiate generics from this --
|
||||
-- unit, or you link this unit with other files to produce an executable, --
|
||||
-- this unit does not by itself cause the resulting executable to be --
|
||||
-- covered by the GNU General Public License. This exception does not --
|
||||
-- however invalidate any other reasons why the executable file might be --
|
||||
-- covered by the GNU Public License. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package provides arithmetic and logical operations on type Address.
|
||||
-- It is intended for use by other packages in the System hierarchy. For
|
||||
-- applications requiring this capability, see System.Storage_Elements or
|
||||
-- the operations introduced in System.Aux_DEC;
|
||||
|
||||
-- The reason we need this package is that arithmetic operations may not
|
||||
-- be available in the case where type Address is non-private and the
|
||||
-- operations have been made abstract in the spec of System (to avoid
|
||||
-- inappropriate use by applications programs). In addition, the logical
|
||||
-- operations may not be available if type Address is a signed integer.
|
||||
|
||||
package System.Address_Operations is
|
||||
pragma Pure (Address_Operations);
|
||||
|
||||
-- The semantics of the arithmetic operations are those that apply to
|
||||
-- a modular type with the same length as Address, i.e. they provide
|
||||
-- twos complement wrap around arithmetic treating the address value
|
||||
-- as an unsigned value, with no overflow checking.
|
||||
|
||||
-- Note that we do not use the infix names for these operations to
|
||||
-- avoid problems with ambiguities coming from declarations in package
|
||||
-- Standard (which may or may not be visible depending on the exact
|
||||
-- form of the declaration of type System.Address).
|
||||
|
||||
function AddA (Left, Right : Address) return Address;
|
||||
function SubA (Left, Right : Address) return Address;
|
||||
function MulA (Left, Right : Address) return Address;
|
||||
function DivA (Left, Right : Address) return Address;
|
||||
function ModA (Left, Right : Address) return Address;
|
||||
|
||||
-- The semantics of the logical operations are those that apply to
|
||||
-- a modular type with the same length as Address, i.e. they provide
|
||||
-- bit-wise operations on all bits of the value (including the sign
|
||||
-- bit if Address is a signed integer type).
|
||||
|
||||
function AndA (Left, Right : Address) return Address;
|
||||
function OrA (Left, Right : Address) return Address;
|
||||
|
||||
pragma Inline_Always (AddA);
|
||||
pragma Inline_Always (SubA);
|
||||
pragma Inline_Always (MulA);
|
||||
pragma Inline_Always (DivA);
|
||||
pragma Inline_Always (ModA);
|
||||
pragma Inline_Always (AndA);
|
||||
pragma Inline_Always (OrA);
|
||||
|
||||
end System.Address_Operations;
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Signed_8 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is mod 2 ** 32;
|
||||
-- Used to process operands by words
|
||||
|
||||
@ -70,15 +66,14 @@ package body System.Compare_Array_Signed_8 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Compare_Len : constant Natural := Natural'Min (Left_Len, Right_Len);
|
||||
|
||||
begin
|
||||
-- If operands are non-aligned, or length is too short, go by bytes
|
||||
|
||||
if (((Left or Right) and 2#11#) /= 0) or else Compare_Len < 4 then
|
||||
if ModA (OrA (Left, Right), 4) /= 0 or else Compare_Len < 4 then
|
||||
return Compare_Array_S8_Unaligned (Left, Right, Left_Len, Right_Len);
|
||||
end if;
|
||||
|
||||
@ -94,15 +89,15 @@ package body System.Compare_Array_Signed_8 is
|
||||
for J in 0 .. Clen4 loop
|
||||
if LeftP (J) /= RightP (J) then
|
||||
return Compare_Array_S8_Unaligned
|
||||
(Left + Address (4 * J),
|
||||
Right + Address (4 * J),
|
||||
(AddA (Left, Address (4 * J)),
|
||||
AddA (Right, Address (4 * J)),
|
||||
4, 4);
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
return Compare_Array_S8_Unaligned
|
||||
(Left + Address (Clen4F),
|
||||
Right + Address (Clen4F),
|
||||
(AddA (Left, Address (Clen4F)),
|
||||
AddA (Right, Address (Clen4F)),
|
||||
Left_Len - Clen4F,
|
||||
Right_Len - Clen4F);
|
||||
end;
|
||||
@ -116,8 +111,7 @@ package body System.Compare_Array_Signed_8 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Compare_Len : constant Natural := Natural'Min (Left_Len, Right_Len);
|
||||
|
||||
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Unsigned_8 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is mod 2 ** 32;
|
||||
-- Used to process operands by words
|
||||
|
||||
@ -69,15 +65,14 @@ package body System.Compare_Array_Unsigned_8 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Compare_Len : constant Natural := Natural'Min (Left_Len, Right_Len);
|
||||
|
||||
begin
|
||||
-- If operands are non-aligned, or length is too short, go by bytes
|
||||
|
||||
if (((Left or Right) and 2#11#) /= 0) or else Compare_Len < 4 then
|
||||
if (ModA (OrA (Left, Right), 4) /= 0) or else Compare_Len < 4 then
|
||||
return Compare_Array_U8_Unaligned (Left, Right, Left_Len, Right_Len);
|
||||
end if;
|
||||
|
||||
@ -93,15 +88,15 @@ package body System.Compare_Array_Unsigned_8 is
|
||||
for J in 0 .. Clen4 loop
|
||||
if LeftP (J) /= RightP (J) then
|
||||
return Compare_Array_U8_Unaligned
|
||||
(Left + Address (4 * J),
|
||||
Right + Address (4 * J),
|
||||
(AddA (Left, Address (4 * J)),
|
||||
AddA (Right, Address (4 * J)),
|
||||
4, 4);
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
return Compare_Array_U8_Unaligned
|
||||
(Left + Address (Clen4F),
|
||||
Right + Address (Clen4F),
|
||||
(AddA (Left, Address (Clen4F)),
|
||||
AddA (Right, Address (Clen4F)),
|
||||
Left_Len - Clen4F,
|
||||
Right_Len - Clen4F);
|
||||
end;
|
||||
@ -115,8 +110,7 @@ package body System.Compare_Array_Unsigned_8 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Compare_Len : constant Natural := Natural'Min (Left_Len, Right_Len);
|
||||
|
||||
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Signed_16 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is mod 2 ** 32;
|
||||
-- Used to process operands by words
|
||||
|
||||
@ -71,8 +67,7 @@ package body System.Compare_Array_Signed_16 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Clen : Natural := Natural'Min (Left_Len, Right_Len);
|
||||
-- Number of elements left to compare
|
||||
@ -84,19 +79,19 @@ package body System.Compare_Array_Signed_16 is
|
||||
begin
|
||||
-- Go by words if possible
|
||||
|
||||
if ((Left or Right) and (4 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 4) = 0 then
|
||||
while Clen > 1
|
||||
and then W (L).all = W (R).all
|
||||
loop
|
||||
Clen := Clen - 2;
|
||||
L := L + 4;
|
||||
R := R + 4;
|
||||
L := AddA (L, 4);
|
||||
R := AddA (R, 4);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Case of going by aligned half words
|
||||
|
||||
if ((Left or Right) and (2 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 2) = 0 then
|
||||
while Clen /= 0 loop
|
||||
if H (L).all /= H (R).all then
|
||||
if H (L).all > H (R).all then
|
||||
@ -107,8 +102,8 @@ package body System.Compare_Array_Signed_16 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 2;
|
||||
R := R + 2;
|
||||
L := AddA (L, 2);
|
||||
R := AddA (R, 2);
|
||||
end loop;
|
||||
|
||||
-- Case of going by unaligned half words
|
||||
@ -124,8 +119,8 @@ package body System.Compare_Array_Signed_16 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 2;
|
||||
R := R + 2;
|
||||
L := AddA (L, 2);
|
||||
R := AddA (R, 2);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Signed_32 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is range -2**31 .. 2**31 - 1;
|
||||
for Word'Size use 32;
|
||||
-- Used to process operands by words
|
||||
@ -66,8 +62,7 @@ package body System.Compare_Array_Signed_32 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Clen : Natural := Natural'Min (Left_Len, Right_Len);
|
||||
-- Number of elements left to compare
|
||||
@ -79,7 +74,7 @@ package body System.Compare_Array_Signed_32 is
|
||||
begin
|
||||
-- Case of going by aligned words
|
||||
|
||||
if ((Left or Right) and (4 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 4) = 0 then
|
||||
while Clen /= 0 loop
|
||||
if W (L).all /= W (R).all then
|
||||
if W (L).all > W (R).all then
|
||||
@ -90,8 +85,8 @@ package body System.Compare_Array_Signed_32 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 4;
|
||||
R := R + 4;
|
||||
L := AddA (L, 4);
|
||||
R := AddA (R, 4);
|
||||
end loop;
|
||||
|
||||
-- Case of going by unaligned words
|
||||
@ -107,8 +102,8 @@ package body System.Compare_Array_Signed_32 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 4;
|
||||
R := R + 4;
|
||||
L := AddA (L, 4);
|
||||
R := AddA (R, 4);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Signed_64 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is range -2**63 .. 2**63 - 1;
|
||||
for Word'Size use 64;
|
||||
-- Used to process operands by words
|
||||
@ -66,8 +62,7 @@ package body System.Compare_Array_Signed_64 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Clen : Natural := Natural'Min (Left_Len, Right_Len);
|
||||
-- Number of elements left to compare
|
||||
@ -77,9 +72,9 @@ package body System.Compare_Array_Signed_64 is
|
||||
-- Pointers to next elements to compare
|
||||
|
||||
begin
|
||||
-- Case of going by aligned words
|
||||
-- Case of going by aligned double words
|
||||
|
||||
if ((Left or Right) and (8 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 8) = 0 then
|
||||
while Clen /= 0 loop
|
||||
if W (L).all /= W (R).all then
|
||||
if W (L).all > W (R).all then
|
||||
@ -90,11 +85,11 @@ package body System.Compare_Array_Signed_64 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 8;
|
||||
R := R + 8;
|
||||
L := AddA (L, 8);
|
||||
R := AddA (R, 8);
|
||||
end loop;
|
||||
|
||||
-- Case of going by unaligned words
|
||||
-- Case of going by unaligned double words
|
||||
|
||||
else
|
||||
while Clen /= 0 loop
|
||||
@ -107,8 +102,8 @@ package body System.Compare_Array_Signed_64 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 8;
|
||||
R := R + 8;
|
||||
L := AddA (L, 8);
|
||||
R := AddA (R, 8);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Unsigned_16 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is mod 2 ** 32;
|
||||
-- Used to process operands by words
|
||||
|
||||
@ -71,8 +67,7 @@ package body System.Compare_Array_Unsigned_16 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Clen : Natural := Natural'Min (Left_Len, Right_Len);
|
||||
-- Number of elements left to compare
|
||||
@ -84,19 +79,19 @@ package body System.Compare_Array_Unsigned_16 is
|
||||
begin
|
||||
-- Go by words if possible
|
||||
|
||||
if ((Left or Right) and (4 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 4) = 0 then
|
||||
while Clen > 1
|
||||
and then W (L).all = W (R).all
|
||||
loop
|
||||
Clen := Clen - 2;
|
||||
L := L + 4;
|
||||
R := R + 4;
|
||||
L := AddA (L, 4);
|
||||
R := AddA (R, 4);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
-- Case of going by aligned half words
|
||||
|
||||
if ((Left or Right) and (2 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 2) = 0 then
|
||||
while Clen /= 0 loop
|
||||
if H (L).all /= H (R).all then
|
||||
if H (L).all > H (R).all then
|
||||
@ -107,8 +102,8 @@ package body System.Compare_Array_Unsigned_16 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 2;
|
||||
R := R + 2;
|
||||
L := AddA (L, 2);
|
||||
R := AddA (R, 2);
|
||||
end loop;
|
||||
|
||||
-- Case of going by unaligned half words
|
||||
@ -124,8 +119,8 @@ package body System.Compare_Array_Unsigned_16 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 2;
|
||||
R := R + 2;
|
||||
L := AddA (L, 2);
|
||||
R := AddA (R, 2);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Unsigned_32 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is mod 2 ** 32;
|
||||
for Word'Size use 32;
|
||||
-- Used to process operands by words
|
||||
@ -66,8 +62,7 @@ package body System.Compare_Array_Unsigned_32 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Clen : Natural := Natural'Min (Left_Len, Right_Len);
|
||||
-- Number of elements left to compare
|
||||
@ -79,7 +74,7 @@ package body System.Compare_Array_Unsigned_32 is
|
||||
begin
|
||||
-- Case of going by aligned words
|
||||
|
||||
if ((Left or Right) and (4 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 4) = 0 then
|
||||
while Clen /= 0 loop
|
||||
if W (L).all /= W (R).all then
|
||||
if W (L).all > W (R).all then
|
||||
@ -90,8 +85,8 @@ package body System.Compare_Array_Unsigned_32 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 4;
|
||||
R := R + 4;
|
||||
L := AddA (L, 4);
|
||||
R := AddA (R, 4);
|
||||
end loop;
|
||||
|
||||
-- Case of going by unaligned words
|
||||
@ -107,8 +102,8 @@ package body System.Compare_Array_Unsigned_32 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 4;
|
||||
R := R + 4;
|
||||
L := AddA (L, 4);
|
||||
R := AddA (R, 4);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
@ -31,16 +31,12 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Compare_Array_Unsigned_64 is
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
-- Provide addition operation on type Address (this may not be directly
|
||||
-- available if type System.Address is non-private and the operations on
|
||||
-- the type are made abstract to hide them from public users of System.
|
||||
|
||||
type Word is mod 2 ** 64;
|
||||
-- Used to process operands by words
|
||||
|
||||
@ -65,8 +61,7 @@ package body System.Compare_Array_Unsigned_64 is
|
||||
(Left : System.Address;
|
||||
Right : System.Address;
|
||||
Left_Len : Natural;
|
||||
Right_Len : Natural)
|
||||
return Integer
|
||||
Right_Len : Natural) return Integer
|
||||
is
|
||||
Clen : Natural := Natural'Min (Left_Len, Right_Len);
|
||||
-- Number of elements left to compare
|
||||
@ -76,9 +71,9 @@ package body System.Compare_Array_Unsigned_64 is
|
||||
-- Pointers to next elements to compare
|
||||
|
||||
begin
|
||||
-- Case of going by aligned words
|
||||
-- Case of going by aligned double words
|
||||
|
||||
if ((Left or Right) and (8 - 1)) = 0 then
|
||||
if ModA (OrA (Left, Right), 8) = 0 then
|
||||
while Clen /= 0 loop
|
||||
if W (L).all /= W (R).all then
|
||||
if W (L).all > W (R).all then
|
||||
@ -89,11 +84,11 @@ package body System.Compare_Array_Unsigned_64 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 8;
|
||||
R := R + 8;
|
||||
L := AddA (L, 8);
|
||||
R := AddA (R, 8);
|
||||
end loop;
|
||||
|
||||
-- Case of going by unaligned words
|
||||
-- Case of going by unaligned double words
|
||||
|
||||
else
|
||||
while Clen /= 0 loop
|
||||
@ -106,8 +101,8 @@ package body System.Compare_Array_Unsigned_64 is
|
||||
end if;
|
||||
|
||||
Clen := Clen - 1;
|
||||
L := L + 8;
|
||||
R := R + 8;
|
||||
L := AddA (L, 8);
|
||||
R := AddA (R, 8);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
|
||||
@ -499,10 +499,11 @@ package body System.Finalization_Implementation is
|
||||
-- Reconstruction of a type with characteristics
|
||||
-- comparable to the original type
|
||||
|
||||
D : constant := Storage_Unit - 1;
|
||||
D : constant := SSE.Storage_Offset (Storage_Unit - 1);
|
||||
|
||||
type Parent_Type is new SSE.Storage_Array
|
||||
(1 .. (Parent_Size (Obj, The_Tag) + D) / Storage_Unit);
|
||||
(1 .. (Parent_Size (Obj, The_Tag) + D) /
|
||||
SSE.Storage_Offset (Storage_Unit));
|
||||
for Parent_Type'Alignment use Address'Alignment;
|
||||
|
||||
type Faked_Type_Of_Obj is record
|
||||
|
||||
@ -31,28 +31,17 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System; use System;
|
||||
with System.Storage_Elements; use System.Storage_Elements;
|
||||
with Ada.Unchecked_Conversion; use Ada;
|
||||
with System; use System;
|
||||
with System.Address_Operations; use System.Address_Operations;
|
||||
with System.Storage_Elements; use System.Storage_Elements;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
package body System.Generic_Vector_Operations is
|
||||
|
||||
-- Provide arithmetic operations on type Address (these may not be
|
||||
-- directly available if type System.Address is non-private and the
|
||||
-- operations on the type are made abstract to hide them from public
|
||||
-- users of System.
|
||||
|
||||
function "mod" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "mod");
|
||||
|
||||
function "+" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "+");
|
||||
|
||||
function "-" (Left, Right : Address) return Address;
|
||||
pragma Import (Intrinsic, "-");
|
||||
|
||||
VU : constant Address := Vectors.Vector'Size / Storage_Unit;
|
||||
EU : constant Address := Element_Array'Component_Size / Storage_Unit;
|
||||
IU : constant Integer := Integer (Storage_Unit);
|
||||
VU : constant Address := Address (Vectors.Vector'Size / IU);
|
||||
EU : constant Address := Address (Element_Array'Component_Size / IU);
|
||||
|
||||
----------------------
|
||||
-- Binary_Operation --
|
||||
@ -67,8 +56,11 @@ package body System.Generic_Vector_Operations is
|
||||
YA : Address := Y;
|
||||
-- Address of next element to process in R, X and Y
|
||||
|
||||
Unaligned : constant Boolean := (RA or XA or YA) mod VU /= 0;
|
||||
-- False iff one or more argument addresses is not aligned
|
||||
VI : constant Integer_Address := To_Integer (VU);
|
||||
|
||||
Unaligned : constant Integer_Address :=
|
||||
Boolean'Pos (ModA (OrA (OrA (RA, XA), YA), VU) /= 0) - 1;
|
||||
-- Zero iff one or more argument addresses is not aligned, else all 1's
|
||||
|
||||
type Vector_Ptr is access all Vectors.Vector;
|
||||
type Element_Ptr is access all Element;
|
||||
@ -76,23 +68,24 @@ package body System.Generic_Vector_Operations is
|
||||
function VP is new Unchecked_Conversion (Address, Vector_Ptr);
|
||||
function EP is new Unchecked_Conversion (Address, Element_Ptr);
|
||||
|
||||
SA : constant Address := XA + ((Length + 0) / VU * VU
|
||||
and (Boolean'Pos (Unaligned) - Address'(1)));
|
||||
SA : constant Address :=
|
||||
AddA (XA, To_Address
|
||||
((Integer_Address (Length) / VI * VI) and Unaligned));
|
||||
-- First address of argument X to start serial processing
|
||||
|
||||
begin
|
||||
while XA < SA loop
|
||||
VP (RA).all := Vector_Op (VP (XA).all, VP (YA).all);
|
||||
XA := XA + VU;
|
||||
YA := YA + VU;
|
||||
RA := RA + VU;
|
||||
XA := AddA (XA, VU);
|
||||
YA := AddA (YA, VU);
|
||||
RA := AddA (RA, VU);
|
||||
end loop;
|
||||
|
||||
while XA < X + Length loop
|
||||
EP (RA).all := Element_Op (EP (XA).all, EP (YA).all);
|
||||
XA := XA + EU;
|
||||
YA := YA + EU;
|
||||
RA := RA + EU;
|
||||
XA := AddA (XA, EU);
|
||||
YA := AddA (YA, EU);
|
||||
RA := AddA (RA, EU);
|
||||
end loop;
|
||||
end Binary_Operation;
|
||||
|
||||
@ -108,8 +101,11 @@ package body System.Generic_Vector_Operations is
|
||||
XA : Address := X;
|
||||
-- Address of next element to process in R and X
|
||||
|
||||
Unaligned : constant Boolean := (RA or XA) mod VU /= 0;
|
||||
-- False iff one or more argument addresses is not aligned
|
||||
VI : constant Integer_Address := To_Integer (VU);
|
||||
|
||||
Unaligned : constant Integer_Address :=
|
||||
Boolean'Pos (ModA (OrA (RA, XA), VU) /= 0) - 1;
|
||||
-- Zero iff one or more argument addresses is not aligned, else all 1's
|
||||
|
||||
type Vector_Ptr is access all Vectors.Vector;
|
||||
type Element_Ptr is access all Element;
|
||||
@ -117,21 +113,22 @@ package body System.Generic_Vector_Operations is
|
||||
function VP is new Unchecked_Conversion (Address, Vector_Ptr);
|
||||
function EP is new Unchecked_Conversion (Address, Element_Ptr);
|
||||
|
||||
SA : constant Address := XA + ((Length + 0) / VU * VU
|
||||
and (Boolean'Pos (Unaligned) - Address'(1)));
|
||||
SA : constant Address :=
|
||||
AddA (XA, To_Address
|
||||
((Integer_Address (Length) / VI * VI) and Unaligned));
|
||||
-- First address of argument X to start serial processing
|
||||
|
||||
begin
|
||||
while XA < SA loop
|
||||
VP (RA).all := Vector_Op (VP (XA).all);
|
||||
XA := XA + VU;
|
||||
RA := RA + VU;
|
||||
XA := AddA (XA, VU);
|
||||
RA := AddA (RA, VU);
|
||||
end loop;
|
||||
|
||||
while XA < X + Length loop
|
||||
EP (RA).all := Element_Op (EP (XA).all);
|
||||
XA := XA + EU;
|
||||
RA := RA + EU;
|
||||
XA := AddA (XA, EU);
|
||||
RA := AddA (RA, EU);
|
||||
end loop;
|
||||
end Unary_Operation;
|
||||
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992,1993,1994 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -43,31 +43,33 @@ package body System.Storage_Elements is
|
||||
|
||||
function "+" (Left : Address; Right : Storage_Offset) return Address is
|
||||
begin
|
||||
return Left + To_Address (Right);
|
||||
return To_Address (To_Integer (Left) + To_Integer (To_Address (Right)));
|
||||
end "+";
|
||||
|
||||
function "+" (Left : Storage_Offset; Right : Address) return Address is
|
||||
begin
|
||||
return To_Address (Left) + Right;
|
||||
return To_Address (To_Integer (To_Address (Left)) + To_Integer (Right));
|
||||
end "+";
|
||||
|
||||
function "-" (Left : Address; Right : Storage_Offset) return Address is
|
||||
begin
|
||||
return Left - To_Address (Right);
|
||||
return To_Address (To_Integer (Left) - To_Integer (To_Address (Right)));
|
||||
end "-";
|
||||
|
||||
function "-" (Left, Right : Address) return Storage_Offset is
|
||||
begin
|
||||
return To_Offset (Left - Right);
|
||||
return To_Offset (To_Address (To_Integer (Left) - To_Integer (Right)));
|
||||
end "-";
|
||||
|
||||
function "mod" (Left : Address; Right : Storage_Offset)
|
||||
return Storage_Offset is
|
||||
begin
|
||||
if Right >= 0 then
|
||||
return Storage_Offset (Address'(Left mod Address (Right)));
|
||||
return Storage_Offset
|
||||
(To_Integer (Left) mod Integer_Address (Right));
|
||||
else
|
||||
return -Storage_Offset (Address'(Left mod Address (-Right)));
|
||||
return -Storage_Offset
|
||||
(To_Integer (Left) mod Integer_Address (-Right));
|
||||
end if;
|
||||
end "mod";
|
||||
|
||||
|
||||
@ -3031,31 +3031,37 @@ package body Sem_Ch6 is
|
||||
or else Subtypes_Statically_Match (Type_1, Full_View (Type_2));
|
||||
end if;
|
||||
|
||||
-- Ada 0Y (AI-254): Detect anonymous access to subprogram types. In
|
||||
-- case of anonymous access to protected subprogram types the anonymous
|
||||
-- type declaration has been replaced by an occurrence of an internal
|
||||
-- access to subprogram type declaration
|
||||
-- Ada 0Y (AI-254): Detect anonymous access to subprogram types.
|
||||
|
||||
Are_Anonymous_Access_To_Subprogram_Types :=
|
||||
|
||||
-- Case 1: Anonymous access to subprogram types
|
||||
|
||||
(Ekind (Type_1) = E_Anonymous_Access_Subprogram_Type
|
||||
and then Ekind (Type_2) = E_Anonymous_Access_Subprogram_Type)
|
||||
or else
|
||||
((Ekind (Type_1) = E_Access_Protected_Subprogram_Type
|
||||
and then Ekind (Type_2) = E_Access_Protected_Subprogram_Type)
|
||||
and then (not Comes_From_Source (Type_1)
|
||||
and not Comes_From_Source (Type_2))
|
||||
and then (Present (Original_Access_Type (Type_1))
|
||||
and Present (Original_Access_Type (Type_2)))
|
||||
and then (Ekind (Original_Access_Type (Type_1))
|
||||
= E_Anonymous_Access_Protected_Subprogram_Type
|
||||
and Ekind (Original_Access_Type (Type_2))
|
||||
= E_Anonymous_Access_Protected_Subprogram_Type));
|
||||
|
||||
-- Case 2: Anonymous access to PROTECTED subprogram types. In this
|
||||
-- case the anonymous type_declaration has been replaced by an
|
||||
-- occurrence of an internal access to subprogram type declaration
|
||||
-- available through the Original_Access_Type attribute
|
||||
|
||||
or else
|
||||
(Ekind (Type_1) = E_Access_Protected_Subprogram_Type
|
||||
and then Ekind (Type_2) = E_Access_Protected_Subprogram_Type
|
||||
and then not Comes_From_Source (Type_1)
|
||||
and then not Comes_From_Source (Type_2)
|
||||
and then Present (Original_Access_Type (Type_1))
|
||||
and then Present (Original_Access_Type (Type_2))
|
||||
and then Ekind (Original_Access_Type (Type_1)) =
|
||||
E_Anonymous_Access_Protected_Subprogram_Type
|
||||
and then Ekind (Original_Access_Type (Type_2)) =
|
||||
E_Anonymous_Access_Protected_Subprogram_Type);
|
||||
|
||||
-- Test anonymous access type case. For this case, static subtype
|
||||
-- matching is required for mode conformance (RM 6.3.1(15))
|
||||
|
||||
if (Ekind (Type_1) = E_Anonymous_Access_Type
|
||||
and then Ekind (Type_2) = E_Anonymous_Access_Type)
|
||||
and then Ekind (Type_2) = E_Anonymous_Access_Type)
|
||||
or else Are_Anonymous_Access_To_Subprogram_Types -- Ada 0Y (AI-254)
|
||||
then
|
||||
declare
|
||||
@ -3065,7 +3071,7 @@ package body Sem_Ch6 is
|
||||
begin
|
||||
Desig_1 := Directly_Designated_Type (Type_1);
|
||||
|
||||
-- An access parameter can designate an incomplete type.
|
||||
-- An access parameter can designate an incomplete type
|
||||
|
||||
if Ekind (Desig_1) = E_Incomplete_Type
|
||||
and then Present (Full_View (Desig_1))
|
||||
|
||||
@ -293,6 +293,7 @@ package body Sem_Dist is
|
||||
RS_Pkg_E : Entity_Id;
|
||||
RAS_Type : Entity_Id;
|
||||
Async_E : Entity_Id;
|
||||
All_Calls_Remote_E : Entity_Id;
|
||||
Attribute_Subp : Entity_Id;
|
||||
Parameter : Node_Id;
|
||||
|
||||
@ -339,6 +340,12 @@ package body Sem_Dist is
|
||||
Async_E := Standard_False;
|
||||
end if;
|
||||
|
||||
if Has_All_Calls_Remote (RS_Pkg_E) then
|
||||
All_Calls_Remote_E := Standard_True;
|
||||
else
|
||||
All_Calls_Remote_E := Standard_False;
|
||||
end if;
|
||||
|
||||
Parameter := New_Occurrence_Of (RTE (RE_Null_Address), Loc);
|
||||
|
||||
Tick_Access_Conv_Call :=
|
||||
@ -349,7 +356,8 @@ package body Sem_Dist is
|
||||
Parameter,
|
||||
Make_String_Literal (Loc, Full_Qualified_Name (RS_Pkg_E)),
|
||||
Build_Subprogram_Id (Loc, Remote_Subp),
|
||||
New_Occurrence_Of (Async_E, Loc)));
|
||||
New_Occurrence_Of (Async_E, Loc),
|
||||
New_Occurrence_Of (All_Calls_Remote_E, Loc)));
|
||||
|
||||
Rewrite (N, Tick_Access_Conv_Call);
|
||||
Analyze_And_Resolve (N, RAS_Type);
|
||||
|
||||
@ -264,10 +264,9 @@ package body Sem_Elim is
|
||||
return;
|
||||
end if;
|
||||
|
||||
Elmt := Elim_Hash_Table.Get (Chars (E));
|
||||
|
||||
-- Loop through homonyms for this key
|
||||
|
||||
Elmt := Elim_Hash_Table.Get (Chars (E));
|
||||
while Elmt /= null loop
|
||||
declare
|
||||
procedure Set_Eliminated;
|
||||
@ -354,7 +353,7 @@ package body Sem_Elim is
|
||||
Set_Eliminated;
|
||||
return;
|
||||
|
||||
-- Check for case of subprogram
|
||||
-- Check for case of subprogram
|
||||
|
||||
elsif Ekind (E) = E_Function
|
||||
or else Ekind (E) = E_Procedure
|
||||
@ -366,7 +365,7 @@ package body Sem_Elim is
|
||||
|
||||
declare
|
||||
Sloc_Trace : constant String :=
|
||||
Name_Buffer (1 .. Name_Len);
|
||||
Name_Buffer (1 .. Name_Len);
|
||||
|
||||
Idx : Natural := Sloc_Trace'First;
|
||||
-- Index in Sloc_Trace, if equals to 0, then we have
|
||||
@ -413,6 +412,10 @@ package body Sem_Elim is
|
||||
-- non-space character in Sloc_Trace to the right of
|
||||
-- Idx. Returns 0 if there is no such character.
|
||||
|
||||
-----------------------------
|
||||
-- Different_Trace_Lengths --
|
||||
-----------------------------
|
||||
|
||||
function Different_Trace_Lengths return Boolean is
|
||||
begin
|
||||
P := Instantiation (Sindex);
|
||||
@ -422,8 +425,8 @@ package body Sem_Elim is
|
||||
(P /= No_Location and then Idx = 0)
|
||||
then
|
||||
return True;
|
||||
else
|
||||
|
||||
else
|
||||
if P /= No_Location then
|
||||
Sindex := Get_Source_File_Index (P);
|
||||
Get_Name_String (File_Name (Sindex));
|
||||
@ -434,10 +437,14 @@ package body Sem_Elim is
|
||||
end Different_Trace_Lengths;
|
||||
|
||||
function File_Mame_Match return Boolean is
|
||||
Tmp_Idx : Positive;
|
||||
End_Idx : Positive;
|
||||
begin
|
||||
Tmp_Idx : Positive := 1;
|
||||
End_Idx : Positive := 1;
|
||||
-- Initializations are to stop warnings
|
||||
|
||||
-- But are warnings possibly valid ???
|
||||
-- Why are loops below guaranteed to exit ???
|
||||
|
||||
begin
|
||||
if Idx = 0 then
|
||||
return False;
|
||||
end if;
|
||||
@ -467,42 +474,40 @@ package body Sem_Elim is
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
|
||||
end File_Mame_Match;
|
||||
|
||||
--------------------
|
||||
-- Line_Num_Match --
|
||||
--------------------
|
||||
|
||||
function Line_Num_Match return Boolean is
|
||||
N : Int := 0;
|
||||
begin
|
||||
|
||||
begin
|
||||
if Idx = 0 then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
while Idx <= Last
|
||||
and then
|
||||
Sloc_Trace (Idx) in '0' .. '9'
|
||||
and then Sloc_Trace (Idx) in '0' .. '9'
|
||||
loop
|
||||
N := N * 10 +
|
||||
(Character'Pos (Sloc_Trace (Idx)) -
|
||||
Character'Pos ('0'));
|
||||
|
||||
Idx := Idx + 1;
|
||||
end loop;
|
||||
|
||||
if Get_Physical_Line_Number (P) =
|
||||
Physical_Line_Number (N)
|
||||
then
|
||||
|
||||
while Sloc_Trace (Idx) /= '['
|
||||
and then
|
||||
Idx <= Last
|
||||
and then Idx <= Last
|
||||
loop
|
||||
Idx := Idx + 1;
|
||||
end loop;
|
||||
|
||||
if Sloc_Trace (Idx) = '['
|
||||
and then
|
||||
Idx < Last
|
||||
and then Idx < Last
|
||||
then
|
||||
Idx := Idx + 1;
|
||||
Idx := Skip_Spaces;
|
||||
@ -514,13 +519,16 @@ package body Sem_Elim is
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
|
||||
end Line_Num_Match;
|
||||
|
||||
-----------------
|
||||
-- Skip_Spaces --
|
||||
-----------------
|
||||
|
||||
function Skip_Spaces return Natural is
|
||||
Res : Natural := Idx;
|
||||
begin
|
||||
|
||||
begin
|
||||
while Sloc_Trace (Res) = ' ' loop
|
||||
Res := Res + 1;
|
||||
|
||||
@ -534,14 +542,12 @@ package body Sem_Elim is
|
||||
end Skip_Spaces;
|
||||
|
||||
begin
|
||||
P := Sloc (E);
|
||||
P := Sloc (E);
|
||||
Sindex := Get_Source_File_Index (P);
|
||||
Get_Name_String (File_Name (Sindex));
|
||||
|
||||
Idx := Skip_Spaces;
|
||||
|
||||
while Idx > 0 loop
|
||||
|
||||
if not File_Mame_Match then
|
||||
goto Continue;
|
||||
elsif not Line_Num_Match then
|
||||
@ -572,10 +578,8 @@ package body Sem_Elim is
|
||||
Form := First_Formal (E);
|
||||
|
||||
if No (Form)
|
||||
and then
|
||||
Elmt.Parameter_Types'Length = 1
|
||||
and then
|
||||
Elmt.Parameter_Types (1) = No_Name
|
||||
and then Elmt.Parameter_Types'Length = 1
|
||||
and then Elmt.Parameter_Types (1) = No_Name
|
||||
then
|
||||
-- Parameterless procedure matches
|
||||
|
||||
@ -607,9 +611,10 @@ package body Sem_Elim is
|
||||
Set_Eliminated;
|
||||
return;
|
||||
end if;
|
||||
|
||||
<<Continue>> Elmt := Elmt.Homonym;
|
||||
end;
|
||||
|
||||
<<Continue>>
|
||||
Elmt := Elmt.Homonym;
|
||||
end loop;
|
||||
|
||||
return;
|
||||
@ -779,8 +784,11 @@ package body Sem_Elim is
|
||||
String_To_Name_Buffer (Strval (Arg_Parameter_Types));
|
||||
|
||||
if Name_Len = 0 then
|
||||
|
||||
-- Parameterless procedure
|
||||
|
||||
Data.Parameter_Types := new Names'(1 => No_Name);
|
||||
|
||||
else
|
||||
Data.Parameter_Types := new Names'(1 => Name_Find);
|
||||
end if;
|
||||
|
||||
@ -337,7 +337,6 @@ package body Snames is
|
||||
"gnat#" &
|
||||
"gpl#" &
|
||||
"ieee_float#" &
|
||||
"homonym_number#" &
|
||||
"internal#" &
|
||||
"link_name#" &
|
||||
"lowercase#" &
|
||||
|
||||
@ -535,49 +535,48 @@ package Snames is
|
||||
Name_Gnat : constant Name_Id := N + 277;
|
||||
Name_GPL : constant Name_Id := N + 278;
|
||||
Name_IEEE_Float : constant Name_Id := N + 279;
|
||||
Name_Homonym_Number : constant Name_Id := N + 280;
|
||||
Name_Internal : constant Name_Id := N + 281;
|
||||
Name_Link_Name : constant Name_Id := N + 282;
|
||||
Name_Lowercase : constant Name_Id := N + 283;
|
||||
Name_Max_Size : constant Name_Id := N + 284;
|
||||
Name_Mechanism : constant Name_Id := N + 285;
|
||||
Name_Mixedcase : constant Name_Id := N + 286;
|
||||
Name_Modified_GPL : constant Name_Id := N + 287;
|
||||
Name_Name : constant Name_Id := N + 288;
|
||||
Name_NCA : constant Name_Id := N + 289;
|
||||
Name_No : constant Name_Id := N + 290;
|
||||
Name_On : constant Name_Id := N + 291;
|
||||
Name_Parameter_Types : constant Name_Id := N + 292;
|
||||
Name_Reference : constant Name_Id := N + 293;
|
||||
Name_No_Requeue : constant Name_Id := N + 294;
|
||||
Name_No_Task_Attributes : constant Name_Id := N + 295;
|
||||
Name_Restricted : constant Name_Id := N + 296;
|
||||
Name_Result_Mechanism : constant Name_Id := N + 297;
|
||||
Name_Result_Type : constant Name_Id := N + 298;
|
||||
Name_Runtime : constant Name_Id := N + 299;
|
||||
Name_SB : constant Name_Id := N + 300;
|
||||
Name_Secondary_Stack_Size : constant Name_Id := N + 301;
|
||||
Name_Section : constant Name_Id := N + 302;
|
||||
Name_Semaphore : constant Name_Id := N + 303;
|
||||
Name_Spec_File_Name : constant Name_Id := N + 304;
|
||||
Name_Static : constant Name_Id := N + 305;
|
||||
Name_Stack_Size : constant Name_Id := N + 306;
|
||||
Name_Subunit_File_Name : constant Name_Id := N + 307;
|
||||
Name_Task_Stack_Size_Default : constant Name_Id := N + 308;
|
||||
Name_Task_Type : constant Name_Id := N + 309;
|
||||
Name_Time_Slicing_Enabled : constant Name_Id := N + 310;
|
||||
Name_Top_Guard : constant Name_Id := N + 311;
|
||||
Name_UBA : constant Name_Id := N + 312;
|
||||
Name_UBS : constant Name_Id := N + 313;
|
||||
Name_UBSB : constant Name_Id := N + 314;
|
||||
Name_Unit_Name : constant Name_Id := N + 315;
|
||||
Name_Unknown : constant Name_Id := N + 316;
|
||||
Name_Unrestricted : constant Name_Id := N + 317;
|
||||
Name_Uppercase : constant Name_Id := N + 318;
|
||||
Name_User : constant Name_Id := N + 319;
|
||||
Name_VAX_Float : constant Name_Id := N + 320;
|
||||
Name_VMS : constant Name_Id := N + 321;
|
||||
Name_Working_Storage : constant Name_Id := N + 322;
|
||||
Name_Internal : constant Name_Id := N + 280;
|
||||
Name_Link_Name : constant Name_Id := N + 281;
|
||||
Name_Lowercase : constant Name_Id := N + 282;
|
||||
Name_Max_Size : constant Name_Id := N + 283;
|
||||
Name_Mechanism : constant Name_Id := N + 284;
|
||||
Name_Mixedcase : constant Name_Id := N + 285;
|
||||
Name_Modified_GPL : constant Name_Id := N + 286;
|
||||
Name_Name : constant Name_Id := N + 287;
|
||||
Name_NCA : constant Name_Id := N + 288;
|
||||
Name_No : constant Name_Id := N + 289;
|
||||
Name_On : constant Name_Id := N + 290;
|
||||
Name_Parameter_Types : constant Name_Id := N + 291;
|
||||
Name_Reference : constant Name_Id := N + 292;
|
||||
Name_No_Requeue : constant Name_Id := N + 293;
|
||||
Name_No_Task_Attributes : constant Name_Id := N + 294;
|
||||
Name_Restricted : constant Name_Id := N + 295;
|
||||
Name_Result_Mechanism : constant Name_Id := N + 296;
|
||||
Name_Result_Type : constant Name_Id := N + 297;
|
||||
Name_Runtime : constant Name_Id := N + 298;
|
||||
Name_SB : constant Name_Id := N + 299;
|
||||
Name_Secondary_Stack_Size : constant Name_Id := N + 300;
|
||||
Name_Section : constant Name_Id := N + 301;
|
||||
Name_Semaphore : constant Name_Id := N + 302;
|
||||
Name_Spec_File_Name : constant Name_Id := N + 303;
|
||||
Name_Static : constant Name_Id := N + 304;
|
||||
Name_Stack_Size : constant Name_Id := N + 305;
|
||||
Name_Subunit_File_Name : constant Name_Id := N + 306;
|
||||
Name_Task_Stack_Size_Default : constant Name_Id := N + 307;
|
||||
Name_Task_Type : constant Name_Id := N + 308;
|
||||
Name_Time_Slicing_Enabled : constant Name_Id := N + 309;
|
||||
Name_Top_Guard : constant Name_Id := N + 310;
|
||||
Name_UBA : constant Name_Id := N + 311;
|
||||
Name_UBS : constant Name_Id := N + 312;
|
||||
Name_UBSB : constant Name_Id := N + 313;
|
||||
Name_Unit_Name : constant Name_Id := N + 314;
|
||||
Name_Unknown : constant Name_Id := N + 315;
|
||||
Name_Unrestricted : constant Name_Id := N + 316;
|
||||
Name_Uppercase : constant Name_Id := N + 317;
|
||||
Name_User : constant Name_Id := N + 318;
|
||||
Name_VAX_Float : constant Name_Id := N + 319;
|
||||
Name_VMS : constant Name_Id := N + 320;
|
||||
Name_Working_Storage : constant Name_Id := N + 321;
|
||||
|
||||
-- Names of recognized attributes. The entries with the comment "Ada 83"
|
||||
-- are attributes that are defined in Ada 83, but not in Ada 95. These
|
||||
@ -591,158 +590,158 @@ package Snames is
|
||||
-- The entries marked VMS are recognized only in OpenVMS implementations
|
||||
-- of GNAT, and are treated as illegal in all other contexts.
|
||||
|
||||
First_Attribute_Name : constant Name_Id := N + 323;
|
||||
Name_Abort_Signal : constant Name_Id := N + 323; -- GNAT
|
||||
Name_Access : constant Name_Id := N + 324;
|
||||
Name_Address : constant Name_Id := N + 325;
|
||||
Name_Address_Size : constant Name_Id := N + 326; -- GNAT
|
||||
Name_Aft : constant Name_Id := N + 327;
|
||||
Name_Alignment : constant Name_Id := N + 328;
|
||||
Name_Asm_Input : constant Name_Id := N + 329; -- GNAT
|
||||
Name_Asm_Output : constant Name_Id := N + 330; -- GNAT
|
||||
Name_AST_Entry : constant Name_Id := N + 331; -- VMS
|
||||
Name_Bit : constant Name_Id := N + 332; -- GNAT
|
||||
Name_Bit_Order : constant Name_Id := N + 333;
|
||||
Name_Bit_Position : constant Name_Id := N + 334; -- GNAT
|
||||
Name_Body_Version : constant Name_Id := N + 335;
|
||||
Name_Callable : constant Name_Id := N + 336;
|
||||
Name_Caller : constant Name_Id := N + 337;
|
||||
Name_Code_Address : constant Name_Id := N + 338; -- GNAT
|
||||
Name_Component_Size : constant Name_Id := N + 339;
|
||||
Name_Compose : constant Name_Id := N + 340;
|
||||
Name_Constrained : constant Name_Id := N + 341;
|
||||
Name_Count : constant Name_Id := N + 342;
|
||||
Name_Default_Bit_Order : constant Name_Id := N + 343; -- GNAT
|
||||
Name_Definite : constant Name_Id := N + 344;
|
||||
Name_Delta : constant Name_Id := N + 345;
|
||||
Name_Denorm : constant Name_Id := N + 346;
|
||||
Name_Digits : constant Name_Id := N + 347;
|
||||
Name_Elaborated : constant Name_Id := N + 348; -- GNAT
|
||||
Name_Emax : constant Name_Id := N + 349; -- Ada 83
|
||||
Name_Enum_Rep : constant Name_Id := N + 350; -- GNAT
|
||||
Name_Epsilon : constant Name_Id := N + 351; -- Ada 83
|
||||
Name_Exponent : constant Name_Id := N + 352;
|
||||
Name_External_Tag : constant Name_Id := N + 353;
|
||||
Name_First : constant Name_Id := N + 354;
|
||||
Name_First_Bit : constant Name_Id := N + 355;
|
||||
Name_Fixed_Value : constant Name_Id := N + 356; -- GNAT
|
||||
Name_Fore : constant Name_Id := N + 357;
|
||||
Name_Has_Discriminants : constant Name_Id := N + 358; -- GNAT
|
||||
Name_Identity : constant Name_Id := N + 359;
|
||||
Name_Img : constant Name_Id := N + 360; -- GNAT
|
||||
Name_Integer_Value : constant Name_Id := N + 361; -- GNAT
|
||||
Name_Large : constant Name_Id := N + 362; -- Ada 83
|
||||
Name_Last : constant Name_Id := N + 363;
|
||||
Name_Last_Bit : constant Name_Id := N + 364;
|
||||
Name_Leading_Part : constant Name_Id := N + 365;
|
||||
Name_Length : constant Name_Id := N + 366;
|
||||
Name_Machine_Emax : constant Name_Id := N + 367;
|
||||
Name_Machine_Emin : constant Name_Id := N + 368;
|
||||
Name_Machine_Mantissa : constant Name_Id := N + 369;
|
||||
Name_Machine_Overflows : constant Name_Id := N + 370;
|
||||
Name_Machine_Radix : constant Name_Id := N + 371;
|
||||
Name_Machine_Rounds : constant Name_Id := N + 372;
|
||||
Name_Machine_Size : constant Name_Id := N + 373; -- GNAT
|
||||
Name_Mantissa : constant Name_Id := N + 374; -- Ada 83
|
||||
Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 375;
|
||||
Name_Maximum_Alignment : constant Name_Id := N + 376; -- GNAT
|
||||
Name_Mechanism_Code : constant Name_Id := N + 377; -- GNAT
|
||||
Name_Model_Emin : constant Name_Id := N + 378;
|
||||
Name_Model_Epsilon : constant Name_Id := N + 379;
|
||||
Name_Model_Mantissa : constant Name_Id := N + 380;
|
||||
Name_Model_Small : constant Name_Id := N + 381;
|
||||
Name_Modulus : constant Name_Id := N + 382;
|
||||
Name_Null_Parameter : constant Name_Id := N + 383; -- GNAT
|
||||
Name_Object_Size : constant Name_Id := N + 384; -- GNAT
|
||||
Name_Partition_ID : constant Name_Id := N + 385;
|
||||
Name_Passed_By_Reference : constant Name_Id := N + 386; -- GNAT
|
||||
Name_Pool_Address : constant Name_Id := N + 387;
|
||||
Name_Pos : constant Name_Id := N + 388;
|
||||
Name_Position : constant Name_Id := N + 389;
|
||||
Name_Range : constant Name_Id := N + 390;
|
||||
Name_Range_Length : constant Name_Id := N + 391; -- GNAT
|
||||
Name_Round : constant Name_Id := N + 392;
|
||||
Name_Safe_Emax : constant Name_Id := N + 393; -- Ada 83
|
||||
Name_Safe_First : constant Name_Id := N + 394;
|
||||
Name_Safe_Large : constant Name_Id := N + 395; -- Ada 83
|
||||
Name_Safe_Last : constant Name_Id := N + 396;
|
||||
Name_Safe_Small : constant Name_Id := N + 397; -- Ada 83
|
||||
Name_Scale : constant Name_Id := N + 398;
|
||||
Name_Scaling : constant Name_Id := N + 399;
|
||||
Name_Signed_Zeros : constant Name_Id := N + 400;
|
||||
Name_Size : constant Name_Id := N + 401;
|
||||
Name_Small : constant Name_Id := N + 402;
|
||||
Name_Storage_Size : constant Name_Id := N + 403;
|
||||
Name_Storage_Unit : constant Name_Id := N + 404; -- GNAT
|
||||
Name_Tag : constant Name_Id := N + 405;
|
||||
Name_Target_Name : constant Name_Id := N + 406; -- GNAT
|
||||
Name_Terminated : constant Name_Id := N + 407;
|
||||
Name_To_Address : constant Name_Id := N + 408; -- GNAT
|
||||
Name_Type_Class : constant Name_Id := N + 409; -- GNAT
|
||||
Name_UET_Address : constant Name_Id := N + 410; -- GNAT
|
||||
Name_Unbiased_Rounding : constant Name_Id := N + 411;
|
||||
Name_Unchecked_Access : constant Name_Id := N + 412;
|
||||
Name_Unconstrained_Array : constant Name_Id := N + 413;
|
||||
Name_Universal_Literal_String : constant Name_Id := N + 414; -- GNAT
|
||||
Name_Unrestricted_Access : constant Name_Id := N + 415; -- GNAT
|
||||
Name_VADS_Size : constant Name_Id := N + 416; -- GNAT
|
||||
Name_Val : constant Name_Id := N + 417;
|
||||
Name_Valid : constant Name_Id := N + 418;
|
||||
Name_Value_Size : constant Name_Id := N + 419; -- GNAT
|
||||
Name_Version : constant Name_Id := N + 420;
|
||||
Name_Wchar_T_Size : constant Name_Id := N + 421; -- GNAT
|
||||
Name_Wide_Width : constant Name_Id := N + 422;
|
||||
Name_Width : constant Name_Id := N + 423;
|
||||
Name_Word_Size : constant Name_Id := N + 424; -- GNAT
|
||||
First_Attribute_Name : constant Name_Id := N + 322;
|
||||
Name_Abort_Signal : constant Name_Id := N + 322; -- GNAT
|
||||
Name_Access : constant Name_Id := N + 323;
|
||||
Name_Address : constant Name_Id := N + 324;
|
||||
Name_Address_Size : constant Name_Id := N + 325; -- GNAT
|
||||
Name_Aft : constant Name_Id := N + 326;
|
||||
Name_Alignment : constant Name_Id := N + 327;
|
||||
Name_Asm_Input : constant Name_Id := N + 328; -- GNAT
|
||||
Name_Asm_Output : constant Name_Id := N + 329; -- GNAT
|
||||
Name_AST_Entry : constant Name_Id := N + 330; -- VMS
|
||||
Name_Bit : constant Name_Id := N + 331; -- GNAT
|
||||
Name_Bit_Order : constant Name_Id := N + 332;
|
||||
Name_Bit_Position : constant Name_Id := N + 333; -- GNAT
|
||||
Name_Body_Version : constant Name_Id := N + 334;
|
||||
Name_Callable : constant Name_Id := N + 335;
|
||||
Name_Caller : constant Name_Id := N + 336;
|
||||
Name_Code_Address : constant Name_Id := N + 337; -- GNAT
|
||||
Name_Component_Size : constant Name_Id := N + 338;
|
||||
Name_Compose : constant Name_Id := N + 339;
|
||||
Name_Constrained : constant Name_Id := N + 340;
|
||||
Name_Count : constant Name_Id := N + 341;
|
||||
Name_Default_Bit_Order : constant Name_Id := N + 342; -- GNAT
|
||||
Name_Definite : constant Name_Id := N + 343;
|
||||
Name_Delta : constant Name_Id := N + 344;
|
||||
Name_Denorm : constant Name_Id := N + 345;
|
||||
Name_Digits : constant Name_Id := N + 346;
|
||||
Name_Elaborated : constant Name_Id := N + 347; -- GNAT
|
||||
Name_Emax : constant Name_Id := N + 348; -- Ada 83
|
||||
Name_Enum_Rep : constant Name_Id := N + 349; -- GNAT
|
||||
Name_Epsilon : constant Name_Id := N + 350; -- Ada 83
|
||||
Name_Exponent : constant Name_Id := N + 351;
|
||||
Name_External_Tag : constant Name_Id := N + 352;
|
||||
Name_First : constant Name_Id := N + 353;
|
||||
Name_First_Bit : constant Name_Id := N + 354;
|
||||
Name_Fixed_Value : constant Name_Id := N + 355; -- GNAT
|
||||
Name_Fore : constant Name_Id := N + 356;
|
||||
Name_Has_Discriminants : constant Name_Id := N + 357; -- GNAT
|
||||
Name_Identity : constant Name_Id := N + 358;
|
||||
Name_Img : constant Name_Id := N + 359; -- GNAT
|
||||
Name_Integer_Value : constant Name_Id := N + 360; -- GNAT
|
||||
Name_Large : constant Name_Id := N + 361; -- Ada 83
|
||||
Name_Last : constant Name_Id := N + 362;
|
||||
Name_Last_Bit : constant Name_Id := N + 363;
|
||||
Name_Leading_Part : constant Name_Id := N + 364;
|
||||
Name_Length : constant Name_Id := N + 365;
|
||||
Name_Machine_Emax : constant Name_Id := N + 366;
|
||||
Name_Machine_Emin : constant Name_Id := N + 367;
|
||||
Name_Machine_Mantissa : constant Name_Id := N + 368;
|
||||
Name_Machine_Overflows : constant Name_Id := N + 369;
|
||||
Name_Machine_Radix : constant Name_Id := N + 370;
|
||||
Name_Machine_Rounds : constant Name_Id := N + 371;
|
||||
Name_Machine_Size : constant Name_Id := N + 372; -- GNAT
|
||||
Name_Mantissa : constant Name_Id := N + 373; -- Ada 83
|
||||
Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 374;
|
||||
Name_Maximum_Alignment : constant Name_Id := N + 375; -- GNAT
|
||||
Name_Mechanism_Code : constant Name_Id := N + 376; -- GNAT
|
||||
Name_Model_Emin : constant Name_Id := N + 377;
|
||||
Name_Model_Epsilon : constant Name_Id := N + 378;
|
||||
Name_Model_Mantissa : constant Name_Id := N + 379;
|
||||
Name_Model_Small : constant Name_Id := N + 380;
|
||||
Name_Modulus : constant Name_Id := N + 381;
|
||||
Name_Null_Parameter : constant Name_Id := N + 382; -- GNAT
|
||||
Name_Object_Size : constant Name_Id := N + 383; -- GNAT
|
||||
Name_Partition_ID : constant Name_Id := N + 384;
|
||||
Name_Passed_By_Reference : constant Name_Id := N + 385; -- GNAT
|
||||
Name_Pool_Address : constant Name_Id := N + 386;
|
||||
Name_Pos : constant Name_Id := N + 387;
|
||||
Name_Position : constant Name_Id := N + 388;
|
||||
Name_Range : constant Name_Id := N + 389;
|
||||
Name_Range_Length : constant Name_Id := N + 390; -- GNAT
|
||||
Name_Round : constant Name_Id := N + 391;
|
||||
Name_Safe_Emax : constant Name_Id := N + 392; -- Ada 83
|
||||
Name_Safe_First : constant Name_Id := N + 393;
|
||||
Name_Safe_Large : constant Name_Id := N + 394; -- Ada 83
|
||||
Name_Safe_Last : constant Name_Id := N + 395;
|
||||
Name_Safe_Small : constant Name_Id := N + 396; -- Ada 83
|
||||
Name_Scale : constant Name_Id := N + 397;
|
||||
Name_Scaling : constant Name_Id := N + 398;
|
||||
Name_Signed_Zeros : constant Name_Id := N + 399;
|
||||
Name_Size : constant Name_Id := N + 400;
|
||||
Name_Small : constant Name_Id := N + 401;
|
||||
Name_Storage_Size : constant Name_Id := N + 402;
|
||||
Name_Storage_Unit : constant Name_Id := N + 403; -- GNAT
|
||||
Name_Tag : constant Name_Id := N + 404;
|
||||
Name_Target_Name : constant Name_Id := N + 405; -- GNAT
|
||||
Name_Terminated : constant Name_Id := N + 406;
|
||||
Name_To_Address : constant Name_Id := N + 407; -- GNAT
|
||||
Name_Type_Class : constant Name_Id := N + 408; -- GNAT
|
||||
Name_UET_Address : constant Name_Id := N + 409; -- GNAT
|
||||
Name_Unbiased_Rounding : constant Name_Id := N + 410;
|
||||
Name_Unchecked_Access : constant Name_Id := N + 411;
|
||||
Name_Unconstrained_Array : constant Name_Id := N + 412;
|
||||
Name_Universal_Literal_String : constant Name_Id := N + 413; -- GNAT
|
||||
Name_Unrestricted_Access : constant Name_Id := N + 414; -- GNAT
|
||||
Name_VADS_Size : constant Name_Id := N + 415; -- GNAT
|
||||
Name_Val : constant Name_Id := N + 416;
|
||||
Name_Valid : constant Name_Id := N + 417;
|
||||
Name_Value_Size : constant Name_Id := N + 418; -- GNAT
|
||||
Name_Version : constant Name_Id := N + 419;
|
||||
Name_Wchar_T_Size : constant Name_Id := N + 420; -- GNAT
|
||||
Name_Wide_Width : constant Name_Id := N + 421;
|
||||
Name_Width : constant Name_Id := N + 422;
|
||||
Name_Word_Size : constant Name_Id := N + 423; -- GNAT
|
||||
|
||||
-- Attributes that designate attributes returning renamable functions,
|
||||
-- i.e. functions that return other than a universal value.
|
||||
|
||||
First_Renamable_Function_Attribute : constant Name_Id := N + 425;
|
||||
Name_Adjacent : constant Name_Id := N + 425;
|
||||
Name_Ceiling : constant Name_Id := N + 426;
|
||||
Name_Copy_Sign : constant Name_Id := N + 427;
|
||||
Name_Floor : constant Name_Id := N + 428;
|
||||
Name_Fraction : constant Name_Id := N + 429;
|
||||
Name_Image : constant Name_Id := N + 430;
|
||||
Name_Input : constant Name_Id := N + 431;
|
||||
Name_Machine : constant Name_Id := N + 432;
|
||||
Name_Max : constant Name_Id := N + 433;
|
||||
Name_Min : constant Name_Id := N + 434;
|
||||
Name_Model : constant Name_Id := N + 435;
|
||||
Name_Pred : constant Name_Id := N + 436;
|
||||
Name_Remainder : constant Name_Id := N + 437;
|
||||
Name_Rounding : constant Name_Id := N + 438;
|
||||
Name_Succ : constant Name_Id := N + 439;
|
||||
Name_Truncation : constant Name_Id := N + 440;
|
||||
Name_Value : constant Name_Id := N + 441;
|
||||
Name_Wide_Image : constant Name_Id := N + 442;
|
||||
Name_Wide_Value : constant Name_Id := N + 443;
|
||||
Last_Renamable_Function_Attribute : constant Name_Id := N + 443;
|
||||
First_Renamable_Function_Attribute : constant Name_Id := N + 424;
|
||||
Name_Adjacent : constant Name_Id := N + 424;
|
||||
Name_Ceiling : constant Name_Id := N + 425;
|
||||
Name_Copy_Sign : constant Name_Id := N + 426;
|
||||
Name_Floor : constant Name_Id := N + 427;
|
||||
Name_Fraction : constant Name_Id := N + 428;
|
||||
Name_Image : constant Name_Id := N + 429;
|
||||
Name_Input : constant Name_Id := N + 430;
|
||||
Name_Machine : constant Name_Id := N + 431;
|
||||
Name_Max : constant Name_Id := N + 432;
|
||||
Name_Min : constant Name_Id := N + 433;
|
||||
Name_Model : constant Name_Id := N + 434;
|
||||
Name_Pred : constant Name_Id := N + 435;
|
||||
Name_Remainder : constant Name_Id := N + 436;
|
||||
Name_Rounding : constant Name_Id := N + 437;
|
||||
Name_Succ : constant Name_Id := N + 438;
|
||||
Name_Truncation : constant Name_Id := N + 439;
|
||||
Name_Value : constant Name_Id := N + 440;
|
||||
Name_Wide_Image : constant Name_Id := N + 441;
|
||||
Name_Wide_Value : constant Name_Id := N + 442;
|
||||
Last_Renamable_Function_Attribute : constant Name_Id := N + 442;
|
||||
|
||||
-- Attributes that designate procedures
|
||||
|
||||
First_Procedure_Attribute : constant Name_Id := N + 444;
|
||||
Name_Output : constant Name_Id := N + 444;
|
||||
Name_Read : constant Name_Id := N + 445;
|
||||
Name_Write : constant Name_Id := N + 446;
|
||||
Last_Procedure_Attribute : constant Name_Id := N + 446;
|
||||
First_Procedure_Attribute : constant Name_Id := N + 443;
|
||||
Name_Output : constant Name_Id := N + 443;
|
||||
Name_Read : constant Name_Id := N + 444;
|
||||
Name_Write : constant Name_Id := N + 445;
|
||||
Last_Procedure_Attribute : constant Name_Id := N + 445;
|
||||
|
||||
-- Remaining attributes are ones that return entities
|
||||
|
||||
First_Entity_Attribute_Name : constant Name_Id := N + 447;
|
||||
Name_Elab_Body : constant Name_Id := N + 447; -- GNAT
|
||||
Name_Elab_Spec : constant Name_Id := N + 448; -- GNAT
|
||||
Name_Storage_Pool : constant Name_Id := N + 449;
|
||||
First_Entity_Attribute_Name : constant Name_Id := N + 446;
|
||||
Name_Elab_Body : constant Name_Id := N + 446; -- GNAT
|
||||
Name_Elab_Spec : constant Name_Id := N + 447; -- GNAT
|
||||
Name_Storage_Pool : constant Name_Id := N + 448;
|
||||
|
||||
-- These attributes are the ones that return types
|
||||
|
||||
First_Type_Attribute_Name : constant Name_Id := N + 450;
|
||||
Name_Base : constant Name_Id := N + 450;
|
||||
Name_Class : constant Name_Id := N + 451;
|
||||
Last_Type_Attribute_Name : constant Name_Id := N + 451;
|
||||
Last_Entity_Attribute_Name : constant Name_Id := N + 451;
|
||||
Last_Attribute_Name : constant Name_Id := N + 451;
|
||||
First_Type_Attribute_Name : constant Name_Id := N + 449;
|
||||
Name_Base : constant Name_Id := N + 449;
|
||||
Name_Class : constant Name_Id := N + 450;
|
||||
Last_Type_Attribute_Name : constant Name_Id := N + 450;
|
||||
Last_Entity_Attribute_Name : constant Name_Id := N + 450;
|
||||
Last_Attribute_Name : constant Name_Id := N + 450;
|
||||
|
||||
-- Names of recognized locking policy identifiers
|
||||
|
||||
@ -750,10 +749,10 @@ package Snames is
|
||||
-- name (e.g. C for Ceiling_Locking). If new policy names are added,
|
||||
-- the first character must be distinct.
|
||||
|
||||
First_Locking_Policy_Name : constant Name_Id := N + 452;
|
||||
Name_Ceiling_Locking : constant Name_Id := N + 452;
|
||||
Name_Inheritance_Locking : constant Name_Id := N + 453;
|
||||
Last_Locking_Policy_Name : constant Name_Id := N + 453;
|
||||
First_Locking_Policy_Name : constant Name_Id := N + 451;
|
||||
Name_Ceiling_Locking : constant Name_Id := N + 451;
|
||||
Name_Inheritance_Locking : constant Name_Id := N + 452;
|
||||
Last_Locking_Policy_Name : constant Name_Id := N + 452;
|
||||
|
||||
-- Names of recognized queuing policy identifiers.
|
||||
|
||||
@ -761,10 +760,10 @@ package Snames is
|
||||
-- name (e.g. F for FIFO_Queuing). If new policy names are added,
|
||||
-- the first character must be distinct.
|
||||
|
||||
First_Queuing_Policy_Name : constant Name_Id := N + 454;
|
||||
Name_FIFO_Queuing : constant Name_Id := N + 454;
|
||||
Name_Priority_Queuing : constant Name_Id := N + 455;
|
||||
Last_Queuing_Policy_Name : constant Name_Id := N + 455;
|
||||
First_Queuing_Policy_Name : constant Name_Id := N + 453;
|
||||
Name_FIFO_Queuing : constant Name_Id := N + 453;
|
||||
Name_Priority_Queuing : constant Name_Id := N + 454;
|
||||
Last_Queuing_Policy_Name : constant Name_Id := N + 454;
|
||||
|
||||
-- Names of recognized task dispatching policy identifiers
|
||||
|
||||
@ -772,193 +771,193 @@ package Snames is
|
||||
-- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names
|
||||
-- are added, the first character must be distinct.
|
||||
|
||||
First_Task_Dispatching_Policy_Name : constant Name_Id := N + 456;
|
||||
Name_FIFO_Within_Priorities : constant Name_Id := N + 456;
|
||||
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 456;
|
||||
First_Task_Dispatching_Policy_Name : constant Name_Id := N + 455;
|
||||
Name_FIFO_Within_Priorities : constant Name_Id := N + 455;
|
||||
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 455;
|
||||
|
||||
-- Names of recognized checks for pragma Suppress
|
||||
|
||||
First_Check_Name : constant Name_Id := N + 457;
|
||||
Name_Access_Check : constant Name_Id := N + 457;
|
||||
Name_Accessibility_Check : constant Name_Id := N + 458;
|
||||
Name_Discriminant_Check : constant Name_Id := N + 459;
|
||||
Name_Division_Check : constant Name_Id := N + 460;
|
||||
Name_Elaboration_Check : constant Name_Id := N + 461;
|
||||
Name_Index_Check : constant Name_Id := N + 462;
|
||||
Name_Length_Check : constant Name_Id := N + 463;
|
||||
Name_Overflow_Check : constant Name_Id := N + 464;
|
||||
Name_Range_Check : constant Name_Id := N + 465;
|
||||
Name_Storage_Check : constant Name_Id := N + 466;
|
||||
Name_Tag_Check : constant Name_Id := N + 467;
|
||||
Name_All_Checks : constant Name_Id := N + 468;
|
||||
Last_Check_Name : constant Name_Id := N + 468;
|
||||
First_Check_Name : constant Name_Id := N + 456;
|
||||
Name_Access_Check : constant Name_Id := N + 456;
|
||||
Name_Accessibility_Check : constant Name_Id := N + 457;
|
||||
Name_Discriminant_Check : constant Name_Id := N + 458;
|
||||
Name_Division_Check : constant Name_Id := N + 459;
|
||||
Name_Elaboration_Check : constant Name_Id := N + 460;
|
||||
Name_Index_Check : constant Name_Id := N + 461;
|
||||
Name_Length_Check : constant Name_Id := N + 462;
|
||||
Name_Overflow_Check : constant Name_Id := N + 463;
|
||||
Name_Range_Check : constant Name_Id := N + 464;
|
||||
Name_Storage_Check : constant Name_Id := N + 465;
|
||||
Name_Tag_Check : constant Name_Id := N + 466;
|
||||
Name_All_Checks : constant Name_Id := N + 467;
|
||||
Last_Check_Name : constant Name_Id := N + 467;
|
||||
|
||||
-- Names corresponding to reserved keywords, excluding those already
|
||||
-- declared in the attribute list (Access, Delta, Digits, Range).
|
||||
|
||||
Name_Abort : constant Name_Id := N + 469;
|
||||
Name_Abs : constant Name_Id := N + 470;
|
||||
Name_Accept : constant Name_Id := N + 471;
|
||||
Name_And : constant Name_Id := N + 472;
|
||||
Name_All : constant Name_Id := N + 473;
|
||||
Name_Array : constant Name_Id := N + 474;
|
||||
Name_At : constant Name_Id := N + 475;
|
||||
Name_Begin : constant Name_Id := N + 476;
|
||||
Name_Body : constant Name_Id := N + 477;
|
||||
Name_Case : constant Name_Id := N + 478;
|
||||
Name_Constant : constant Name_Id := N + 479;
|
||||
Name_Declare : constant Name_Id := N + 480;
|
||||
Name_Delay : constant Name_Id := N + 481;
|
||||
Name_Do : constant Name_Id := N + 482;
|
||||
Name_Else : constant Name_Id := N + 483;
|
||||
Name_Elsif : constant Name_Id := N + 484;
|
||||
Name_End : constant Name_Id := N + 485;
|
||||
Name_Entry : constant Name_Id := N + 486;
|
||||
Name_Exception : constant Name_Id := N + 487;
|
||||
Name_Exit : constant Name_Id := N + 488;
|
||||
Name_For : constant Name_Id := N + 489;
|
||||
Name_Function : constant Name_Id := N + 490;
|
||||
Name_Generic : constant Name_Id := N + 491;
|
||||
Name_Goto : constant Name_Id := N + 492;
|
||||
Name_If : constant Name_Id := N + 493;
|
||||
Name_In : constant Name_Id := N + 494;
|
||||
Name_Is : constant Name_Id := N + 495;
|
||||
Name_Limited : constant Name_Id := N + 496;
|
||||
Name_Loop : constant Name_Id := N + 497;
|
||||
Name_Mod : constant Name_Id := N + 498;
|
||||
Name_New : constant Name_Id := N + 499;
|
||||
Name_Not : constant Name_Id := N + 500;
|
||||
Name_Null : constant Name_Id := N + 501;
|
||||
Name_Of : constant Name_Id := N + 502;
|
||||
Name_Or : constant Name_Id := N + 503;
|
||||
Name_Others : constant Name_Id := N + 504;
|
||||
Name_Out : constant Name_Id := N + 505;
|
||||
Name_Package : constant Name_Id := N + 506;
|
||||
Name_Pragma : constant Name_Id := N + 507;
|
||||
Name_Private : constant Name_Id := N + 508;
|
||||
Name_Procedure : constant Name_Id := N + 509;
|
||||
Name_Raise : constant Name_Id := N + 510;
|
||||
Name_Record : constant Name_Id := N + 511;
|
||||
Name_Rem : constant Name_Id := N + 512;
|
||||
Name_Renames : constant Name_Id := N + 513;
|
||||
Name_Return : constant Name_Id := N + 514;
|
||||
Name_Reverse : constant Name_Id := N + 515;
|
||||
Name_Select : constant Name_Id := N + 516;
|
||||
Name_Separate : constant Name_Id := N + 517;
|
||||
Name_Subtype : constant Name_Id := N + 518;
|
||||
Name_Task : constant Name_Id := N + 519;
|
||||
Name_Terminate : constant Name_Id := N + 520;
|
||||
Name_Then : constant Name_Id := N + 521;
|
||||
Name_Type : constant Name_Id := N + 522;
|
||||
Name_Use : constant Name_Id := N + 523;
|
||||
Name_When : constant Name_Id := N + 524;
|
||||
Name_While : constant Name_Id := N + 525;
|
||||
Name_With : constant Name_Id := N + 526;
|
||||
Name_Xor : constant Name_Id := N + 527;
|
||||
Name_Abort : constant Name_Id := N + 468;
|
||||
Name_Abs : constant Name_Id := N + 469;
|
||||
Name_Accept : constant Name_Id := N + 470;
|
||||
Name_And : constant Name_Id := N + 471;
|
||||
Name_All : constant Name_Id := N + 472;
|
||||
Name_Array : constant Name_Id := N + 473;
|
||||
Name_At : constant Name_Id := N + 474;
|
||||
Name_Begin : constant Name_Id := N + 475;
|
||||
Name_Body : constant Name_Id := N + 476;
|
||||
Name_Case : constant Name_Id := N + 477;
|
||||
Name_Constant : constant Name_Id := N + 478;
|
||||
Name_Declare : constant Name_Id := N + 479;
|
||||
Name_Delay : constant Name_Id := N + 480;
|
||||
Name_Do : constant Name_Id := N + 481;
|
||||
Name_Else : constant Name_Id := N + 482;
|
||||
Name_Elsif : constant Name_Id := N + 483;
|
||||
Name_End : constant Name_Id := N + 484;
|
||||
Name_Entry : constant Name_Id := N + 485;
|
||||
Name_Exception : constant Name_Id := N + 486;
|
||||
Name_Exit : constant Name_Id := N + 487;
|
||||
Name_For : constant Name_Id := N + 488;
|
||||
Name_Function : constant Name_Id := N + 489;
|
||||
Name_Generic : constant Name_Id := N + 490;
|
||||
Name_Goto : constant Name_Id := N + 491;
|
||||
Name_If : constant Name_Id := N + 492;
|
||||
Name_In : constant Name_Id := N + 493;
|
||||
Name_Is : constant Name_Id := N + 494;
|
||||
Name_Limited : constant Name_Id := N + 495;
|
||||
Name_Loop : constant Name_Id := N + 496;
|
||||
Name_Mod : constant Name_Id := N + 497;
|
||||
Name_New : constant Name_Id := N + 498;
|
||||
Name_Not : constant Name_Id := N + 499;
|
||||
Name_Null : constant Name_Id := N + 500;
|
||||
Name_Of : constant Name_Id := N + 501;
|
||||
Name_Or : constant Name_Id := N + 502;
|
||||
Name_Others : constant Name_Id := N + 503;
|
||||
Name_Out : constant Name_Id := N + 504;
|
||||
Name_Package : constant Name_Id := N + 505;
|
||||
Name_Pragma : constant Name_Id := N + 506;
|
||||
Name_Private : constant Name_Id := N + 507;
|
||||
Name_Procedure : constant Name_Id := N + 508;
|
||||
Name_Raise : constant Name_Id := N + 509;
|
||||
Name_Record : constant Name_Id := N + 510;
|
||||
Name_Rem : constant Name_Id := N + 511;
|
||||
Name_Renames : constant Name_Id := N + 512;
|
||||
Name_Return : constant Name_Id := N + 513;
|
||||
Name_Reverse : constant Name_Id := N + 514;
|
||||
Name_Select : constant Name_Id := N + 515;
|
||||
Name_Separate : constant Name_Id := N + 516;
|
||||
Name_Subtype : constant Name_Id := N + 517;
|
||||
Name_Task : constant Name_Id := N + 518;
|
||||
Name_Terminate : constant Name_Id := N + 519;
|
||||
Name_Then : constant Name_Id := N + 520;
|
||||
Name_Type : constant Name_Id := N + 521;
|
||||
Name_Use : constant Name_Id := N + 522;
|
||||
Name_When : constant Name_Id := N + 523;
|
||||
Name_While : constant Name_Id := N + 524;
|
||||
Name_With : constant Name_Id := N + 525;
|
||||
Name_Xor : constant Name_Id := N + 526;
|
||||
|
||||
-- Names of intrinsic subprograms
|
||||
|
||||
-- Note: Asm is missing from this list, since Asm is a legitimate
|
||||
-- convention name. So is To_Adress, which is a GNAT attribute.
|
||||
|
||||
First_Intrinsic_Name : constant Name_Id := N + 528;
|
||||
Name_Divide : constant Name_Id := N + 528;
|
||||
Name_Enclosing_Entity : constant Name_Id := N + 529;
|
||||
Name_Exception_Information : constant Name_Id := N + 530;
|
||||
Name_Exception_Message : constant Name_Id := N + 531;
|
||||
Name_Exception_Name : constant Name_Id := N + 532;
|
||||
Name_File : constant Name_Id := N + 533;
|
||||
Name_Import_Address : constant Name_Id := N + 534;
|
||||
Name_Import_Largest_Value : constant Name_Id := N + 535;
|
||||
Name_Import_Value : constant Name_Id := N + 536;
|
||||
Name_Is_Negative : constant Name_Id := N + 537;
|
||||
Name_Line : constant Name_Id := N + 538;
|
||||
Name_Rotate_Left : constant Name_Id := N + 539;
|
||||
Name_Rotate_Right : constant Name_Id := N + 540;
|
||||
Name_Shift_Left : constant Name_Id := N + 541;
|
||||
Name_Shift_Right : constant Name_Id := N + 542;
|
||||
Name_Shift_Right_Arithmetic : constant Name_Id := N + 543;
|
||||
Name_Source_Location : constant Name_Id := N + 544;
|
||||
Name_Unchecked_Conversion : constant Name_Id := N + 545;
|
||||
Name_Unchecked_Deallocation : constant Name_Id := N + 546;
|
||||
Name_To_Pointer : constant Name_Id := N + 547;
|
||||
Last_Intrinsic_Name : constant Name_Id := N + 547;
|
||||
First_Intrinsic_Name : constant Name_Id := N + 527;
|
||||
Name_Divide : constant Name_Id := N + 527;
|
||||
Name_Enclosing_Entity : constant Name_Id := N + 528;
|
||||
Name_Exception_Information : constant Name_Id := N + 529;
|
||||
Name_Exception_Message : constant Name_Id := N + 530;
|
||||
Name_Exception_Name : constant Name_Id := N + 531;
|
||||
Name_File : constant Name_Id := N + 532;
|
||||
Name_Import_Address : constant Name_Id := N + 533;
|
||||
Name_Import_Largest_Value : constant Name_Id := N + 534;
|
||||
Name_Import_Value : constant Name_Id := N + 535;
|
||||
Name_Is_Negative : constant Name_Id := N + 536;
|
||||
Name_Line : constant Name_Id := N + 537;
|
||||
Name_Rotate_Left : constant Name_Id := N + 538;
|
||||
Name_Rotate_Right : constant Name_Id := N + 539;
|
||||
Name_Shift_Left : constant Name_Id := N + 540;
|
||||
Name_Shift_Right : constant Name_Id := N + 541;
|
||||
Name_Shift_Right_Arithmetic : constant Name_Id := N + 542;
|
||||
Name_Source_Location : constant Name_Id := N + 543;
|
||||
Name_Unchecked_Conversion : constant Name_Id := N + 544;
|
||||
Name_Unchecked_Deallocation : constant Name_Id := N + 545;
|
||||
Name_To_Pointer : constant Name_Id := N + 546;
|
||||
Last_Intrinsic_Name : constant Name_Id := N + 546;
|
||||
|
||||
-- Reserved words used only in Ada 95
|
||||
|
||||
First_95_Reserved_Word : constant Name_Id := N + 548;
|
||||
Name_Abstract : constant Name_Id := N + 548;
|
||||
Name_Aliased : constant Name_Id := N + 549;
|
||||
Name_Protected : constant Name_Id := N + 550;
|
||||
Name_Until : constant Name_Id := N + 551;
|
||||
Name_Requeue : constant Name_Id := N + 552;
|
||||
Name_Tagged : constant Name_Id := N + 553;
|
||||
Last_95_Reserved_Word : constant Name_Id := N + 553;
|
||||
First_95_Reserved_Word : constant Name_Id := N + 547;
|
||||
Name_Abstract : constant Name_Id := N + 547;
|
||||
Name_Aliased : constant Name_Id := N + 548;
|
||||
Name_Protected : constant Name_Id := N + 549;
|
||||
Name_Until : constant Name_Id := N + 550;
|
||||
Name_Requeue : constant Name_Id := N + 551;
|
||||
Name_Tagged : constant Name_Id := N + 552;
|
||||
Last_95_Reserved_Word : constant Name_Id := N + 552;
|
||||
|
||||
subtype Ada_95_Reserved_Words is
|
||||
Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
|
||||
|
||||
-- Miscellaneous names used in semantic checking
|
||||
|
||||
Name_Raise_Exception : constant Name_Id := N + 554;
|
||||
Name_Raise_Exception : constant Name_Id := N + 553;
|
||||
|
||||
-- Additional reserved words in GNAT Project Files
|
||||
-- Note that Name_External is already previously declared
|
||||
|
||||
Name_Binder : constant Name_Id := N + 555;
|
||||
Name_Body_Suffix : constant Name_Id := N + 556;
|
||||
Name_Builder : constant Name_Id := N + 557;
|
||||
Name_Compiler : constant Name_Id := N + 558;
|
||||
Name_Cross_Reference : constant Name_Id := N + 559;
|
||||
Name_Default_Switches : constant Name_Id := N + 560;
|
||||
Name_Exec_Dir : constant Name_Id := N + 561;
|
||||
Name_Executable : constant Name_Id := N + 562;
|
||||
Name_Executable_Suffix : constant Name_Id := N + 563;
|
||||
Name_Extends : constant Name_Id := N + 564;
|
||||
Name_Finder : constant Name_Id := N + 565;
|
||||
Name_Global_Configuration_Pragmas : constant Name_Id := N + 566;
|
||||
Name_Gnatls : constant Name_Id := N + 567;
|
||||
Name_Gnatstub : constant Name_Id := N + 568;
|
||||
Name_Implementation : constant Name_Id := N + 569;
|
||||
Name_Implementation_Exceptions : constant Name_Id := N + 570;
|
||||
Name_Implementation_Suffix : constant Name_Id := N + 571;
|
||||
Name_Languages : constant Name_Id := N + 572;
|
||||
Name_Library_Dir : constant Name_Id := N + 573;
|
||||
Name_Library_Auto_Init : constant Name_Id := N + 574;
|
||||
Name_Library_GCC : constant Name_Id := N + 575;
|
||||
Name_Library_Interface : constant Name_Id := N + 576;
|
||||
Name_Library_Kind : constant Name_Id := N + 577;
|
||||
Name_Library_Name : constant Name_Id := N + 578;
|
||||
Name_Library_Options : constant Name_Id := N + 579;
|
||||
Name_Library_Reference_Symbol_File : constant Name_Id := N + 580;
|
||||
Name_Library_Src_Dir : constant Name_Id := N + 581;
|
||||
Name_Library_Symbol_File : constant Name_Id := N + 582;
|
||||
Name_Library_Symbol_Policy : constant Name_Id := N + 583;
|
||||
Name_Library_Version : constant Name_Id := N + 584;
|
||||
Name_Linker : constant Name_Id := N + 585;
|
||||
Name_Local_Configuration_Pragmas : constant Name_Id := N + 586;
|
||||
Name_Locally_Removed_Files : constant Name_Id := N + 587;
|
||||
Name_Naming : constant Name_Id := N + 588;
|
||||
Name_Object_Dir : constant Name_Id := N + 589;
|
||||
Name_Pretty_Printer : constant Name_Id := N + 590;
|
||||
Name_Project : constant Name_Id := N + 591;
|
||||
Name_Separate_Suffix : constant Name_Id := N + 592;
|
||||
Name_Source_Dirs : constant Name_Id := N + 593;
|
||||
Name_Source_Files : constant Name_Id := N + 594;
|
||||
Name_Source_List_File : constant Name_Id := N + 595;
|
||||
Name_Spec : constant Name_Id := N + 596;
|
||||
Name_Spec_Suffix : constant Name_Id := N + 597;
|
||||
Name_Specification : constant Name_Id := N + 598;
|
||||
Name_Specification_Exceptions : constant Name_Id := N + 599;
|
||||
Name_Specification_Suffix : constant Name_Id := N + 600;
|
||||
Name_Switches : constant Name_Id := N + 601;
|
||||
Name_Binder : constant Name_Id := N + 554;
|
||||
Name_Body_Suffix : constant Name_Id := N + 555;
|
||||
Name_Builder : constant Name_Id := N + 556;
|
||||
Name_Compiler : constant Name_Id := N + 557;
|
||||
Name_Cross_Reference : constant Name_Id := N + 558;
|
||||
Name_Default_Switches : constant Name_Id := N + 559;
|
||||
Name_Exec_Dir : constant Name_Id := N + 560;
|
||||
Name_Executable : constant Name_Id := N + 561;
|
||||
Name_Executable_Suffix : constant Name_Id := N + 562;
|
||||
Name_Extends : constant Name_Id := N + 563;
|
||||
Name_Finder : constant Name_Id := N + 564;
|
||||
Name_Global_Configuration_Pragmas : constant Name_Id := N + 565;
|
||||
Name_Gnatls : constant Name_Id := N + 566;
|
||||
Name_Gnatstub : constant Name_Id := N + 567;
|
||||
Name_Implementation : constant Name_Id := N + 568;
|
||||
Name_Implementation_Exceptions : constant Name_Id := N + 569;
|
||||
Name_Implementation_Suffix : constant Name_Id := N + 570;
|
||||
Name_Languages : constant Name_Id := N + 571;
|
||||
Name_Library_Dir : constant Name_Id := N + 572;
|
||||
Name_Library_Auto_Init : constant Name_Id := N + 573;
|
||||
Name_Library_GCC : constant Name_Id := N + 574;
|
||||
Name_Library_Interface : constant Name_Id := N + 575;
|
||||
Name_Library_Kind : constant Name_Id := N + 576;
|
||||
Name_Library_Name : constant Name_Id := N + 577;
|
||||
Name_Library_Options : constant Name_Id := N + 578;
|
||||
Name_Library_Reference_Symbol_File : constant Name_Id := N + 579;
|
||||
Name_Library_Src_Dir : constant Name_Id := N + 580;
|
||||
Name_Library_Symbol_File : constant Name_Id := N + 581;
|
||||
Name_Library_Symbol_Policy : constant Name_Id := N + 582;
|
||||
Name_Library_Version : constant Name_Id := N + 583;
|
||||
Name_Linker : constant Name_Id := N + 584;
|
||||
Name_Local_Configuration_Pragmas : constant Name_Id := N + 585;
|
||||
Name_Locally_Removed_Files : constant Name_Id := N + 586;
|
||||
Name_Naming : constant Name_Id := N + 587;
|
||||
Name_Object_Dir : constant Name_Id := N + 588;
|
||||
Name_Pretty_Printer : constant Name_Id := N + 589;
|
||||
Name_Project : constant Name_Id := N + 590;
|
||||
Name_Separate_Suffix : constant Name_Id := N + 591;
|
||||
Name_Source_Dirs : constant Name_Id := N + 592;
|
||||
Name_Source_Files : constant Name_Id := N + 593;
|
||||
Name_Source_List_File : constant Name_Id := N + 594;
|
||||
Name_Spec : constant Name_Id := N + 595;
|
||||
Name_Spec_Suffix : constant Name_Id := N + 596;
|
||||
Name_Specification : constant Name_Id := N + 597;
|
||||
Name_Specification_Exceptions : constant Name_Id := N + 598;
|
||||
Name_Specification_Suffix : constant Name_Id := N + 599;
|
||||
Name_Switches : constant Name_Id := N + 600;
|
||||
-- Other miscellaneous names used in front end
|
||||
|
||||
Name_Unaligned_Valid : constant Name_Id := N + 602;
|
||||
Name_Unaligned_Valid : constant Name_Id := N + 601;
|
||||
|
||||
-- Mark last defined name for consistency check in Snames body
|
||||
|
||||
Last_Predefined_Name : constant Name_Id := N + 602;
|
||||
Last_Predefined_Name : constant Name_Id := N + 601;
|
||||
|
||||
subtype Any_Operator_Name is Name_Id range
|
||||
First_Operator_Name .. Last_Operator_Name;
|
||||
|
||||
@ -2107,37 +2107,31 @@ tree_transform (Node_Id gnat_node)
|
||||
case N_If_Statement:
|
||||
gnu_result = NULL_TREE;
|
||||
|
||||
/* Make an IF_STMT for each of the "else if" parts. */
|
||||
/* Make an IF_STMT for each of the "else if" parts. Avoid
|
||||
non-determinism. */
|
||||
if (Present (Elsif_Parts (gnat_node)))
|
||||
for (gnat_temp = First (Elsif_Parts (gnat_node));
|
||||
Present (gnat_temp); gnat_temp = Next (gnat_temp))
|
||||
{
|
||||
tree gnu_cond, gnu_elseif;
|
||||
gnu_expr = make_node (IF_STMT);
|
||||
|
||||
gnu_cond = gnat_to_gnu (Condition (gnat_temp));
|
||||
gnu_elseif
|
||||
= build_nt (IF_STMT, gnu_cond,
|
||||
build_block_stmt (Then_Statements (gnat_temp)),
|
||||
NULL_TREE, NULL_TREE);
|
||||
|
||||
TREE_SLOC (gnu_elseif) = Sloc (Condition (gnat_temp));
|
||||
TREE_CHAIN (gnu_elseif) = gnu_result;
|
||||
TREE_TYPE (gnu_elseif) = void_type_node;
|
||||
gnu_result = gnu_elseif;
|
||||
IF_STMT_COND (gnu_expr) = gnat_to_gnu (Condition (gnat_temp));
|
||||
IF_STMT_TRUE (gnu_expr)
|
||||
= build_block_stmt (Then_Statements (gnat_temp));
|
||||
IF_STMT_ELSE (gnu_expr) = IF_STMT_ELSEIF (gnu_expr) = NULL_TREE;
|
||||
TREE_SLOC (gnu_expr) = Sloc (Condition (gnat_temp));
|
||||
TREE_CHAIN (gnu_expr) = gnu_result;
|
||||
TREE_TYPE (gnu_expr) = void_type_node;
|
||||
gnu_result = gnu_expr;
|
||||
}
|
||||
|
||||
{
|
||||
tree gnu_cond, then_block, else_block;
|
||||
|
||||
gnu_cond = gnat_to_gnu (Condition (gnat_node));
|
||||
then_block = build_block_stmt (Then_Statements (gnat_node));
|
||||
else_block = build_block_stmt (Else_Statements (gnat_node));
|
||||
|
||||
gnu_result = build_nt (IF_STMT, gnu_cond,
|
||||
then_block,
|
||||
nreverse (gnu_result),
|
||||
else_block);
|
||||
}
|
||||
/* Now make the IF_STMT. Also avoid non-determinism. */
|
||||
gnu_expr = make_node (IF_STMT);
|
||||
IF_STMT_COND (gnu_expr) = gnat_to_gnu (Condition (gnat_node));
|
||||
IF_STMT_TRUE (gnu_expr) = build_block_stmt (Then_Statements (gnat_node));
|
||||
IF_STMT_ELSEIF (gnu_expr) = nreverse (gnu_result);
|
||||
IF_STMT_ELSE (gnu_expr) = build_block_stmt (Else_Statements (gnat_node));
|
||||
gnu_result = gnu_expr;
|
||||
break;
|
||||
|
||||
case N_Case_Statement:
|
||||
@ -2264,7 +2258,7 @@ tree_transform (Node_Id gnat_node)
|
||||
/* Communicate to GCC that we are done with the current WHEN,
|
||||
i.e. insert a "break" statement. */
|
||||
expand_exit_something ();
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
}
|
||||
|
||||
@ -2403,7 +2397,7 @@ tree_transform (Node_Id gnat_node)
|
||||
gnat_statement = Next (gnat_statement))
|
||||
gnat_to_code (gnat_statement);
|
||||
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
gnu_block_stack = TREE_CHAIN (gnu_block_stack);
|
||||
|
||||
@ -2429,7 +2423,7 @@ tree_transform (Node_Id gnat_node)
|
||||
/* Close the nesting level that sourround the loop that was used to
|
||||
declare the loop index variable. */
|
||||
set_lineno (gnat_node, 1);
|
||||
expand_end_bindings (getdecls (), 1, -1);
|
||||
expand_end_bindings (NULL_TREE, 1, -1);
|
||||
poplevel (1, 1, 0);
|
||||
}
|
||||
|
||||
@ -2447,7 +2441,7 @@ tree_transform (Node_Id gnat_node)
|
||||
expand_start_bindings (0);
|
||||
process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
|
||||
gnat_to_code (Handled_Statement_Sequence (gnat_node));
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
gnu_block_stack = TREE_CHAIN (gnu_block_stack);
|
||||
if (Present (Identifier (gnat_node)))
|
||||
@ -2733,7 +2727,7 @@ tree_transform (Node_Id gnat_node)
|
||||
will be present and any OUT parameters will be handled there. */
|
||||
gnat_to_code (Handled_Statement_Sequence (gnat_node));
|
||||
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
gnu_block_stack = TREE_CHAIN (gnu_block_stack);
|
||||
|
||||
@ -3539,7 +3533,7 @@ tree_transform (Node_Id gnat_node)
|
||||
gnu_except_ptr_stack = TREE_CHAIN (gnu_except_ptr_stack);
|
||||
|
||||
/* End the binding level dedicated to the exception handlers. */
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
|
||||
/* End the "if" on setjmp. Note that we have arranged things so
|
||||
@ -3602,7 +3596,7 @@ tree_transform (Node_Id gnat_node)
|
||||
/* Close the binding level we made, if any. */
|
||||
if (exitable_binding_for_block)
|
||||
{
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
}
|
||||
}
|
||||
@ -3810,7 +3804,7 @@ tree_transform (Node_Id gnat_node)
|
||||
if (Exception_Mechanism == GCC_ZCX)
|
||||
{
|
||||
/* Tell the back end that we're done with the current handler. */
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
|
||||
expand_end_catch ();
|
||||
@ -5542,7 +5536,7 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
|
||||
break;
|
||||
}
|
||||
|
||||
expand_end_bindings (getdecls (), kept_level_p (), -1);
|
||||
expand_end_bindings (NULL_TREE, kept_level_p (), -1);
|
||||
poplevel (kept_level_p (), 1, 0);
|
||||
gnu_block_stack = TREE_CHAIN (gnu_block_stack);
|
||||
end_subprog_body ();
|
||||
|
||||
@ -1841,9 +1841,7 @@ static int function_nesting_depth;
|
||||
void
|
||||
begin_subprog_body (tree subprog_decl)
|
||||
{
|
||||
tree param_decl_list;
|
||||
tree param_decl;
|
||||
tree next_param;
|
||||
|
||||
if (function_nesting_depth++ != 0)
|
||||
push_function_context ();
|
||||
@ -1859,32 +1857,14 @@ begin_subprog_body (tree subprog_decl)
|
||||
the C sense! */
|
||||
TREE_STATIC (subprog_decl) = 1;
|
||||
|
||||
/* Enter a new binding level. */
|
||||
/* Enter a new binding level and show that all the parameters belong to
|
||||
this function. */
|
||||
current_function_decl = subprog_decl;
|
||||
pushlevel (0);
|
||||
|
||||
/* Push all the PARM_DECL nodes onto the current scope (i.e. the scope of the
|
||||
subprogram body) so that they can be recognized as local variables in the
|
||||
subprogram.
|
||||
|
||||
The list of PARM_DECL nodes is stored in the right order in
|
||||
DECL_ARGUMENTS. Since ..._DECL nodes get stored in the reverse order in
|
||||
which they are transmitted to `pushdecl' we need to reverse the list of
|
||||
PARM_DECLs if we want it to be stored in the right order. The reason why
|
||||
we want to make sure the PARM_DECLs are stored in the correct order is
|
||||
that this list will be retrieved in a few lines with a call to `getdecl'
|
||||
to store it back into the DECL_ARGUMENTS field. */
|
||||
param_decl_list = nreverse (DECL_ARGUMENTS (subprog_decl));
|
||||
|
||||
for (param_decl = param_decl_list; param_decl; param_decl = next_param)
|
||||
{
|
||||
next_param = TREE_CHAIN (param_decl);
|
||||
TREE_CHAIN (param_decl) = NULL;
|
||||
pushdecl (param_decl);
|
||||
}
|
||||
|
||||
/* Store back the PARM_DECL nodes. They appear in the right order. */
|
||||
DECL_ARGUMENTS (subprog_decl) = getdecls ();
|
||||
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
|
||||
param_decl = TREE_CHAIN (param_decl))
|
||||
DECL_CONTEXT (param_decl) = subprog_decl;
|
||||
|
||||
init_function_start (subprog_decl);
|
||||
expand_function_start (subprog_decl, 0);
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user