-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1998, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
package Ada.Calendar.Delays is
procedure Delay_For (D : Duration);
- -- Delay until an interval of length (at least) D seconds has passed,
- -- or the task is aborted to at least the current ATC nesting level.
- -- This is an abort completion point.
- -- The body of this procedure must perform all the processing
- -- required for an abortion point.
+ -- Delay until an interval of length (at least) D seconds has passed, or
+ -- the task is aborted to at least the current ATC nesting level. This is
+ -- an abort completion point. The body of this procedure must perform all
+ -- the processing required for an abort point.
procedure Delay_Until (T : Time);
- -- Delay until Clock has reached (at least) time T,
- -- or the task is aborted to at least the current ATC nesting level.
- -- The body of this procedure must perform all the processing
- -- required for an abortion point.
+ -- Delay until Clock has reached (at least) time T, or the task is aborted
+ -- to at least the current ATC nesting level. The body of this procedure
+ -- must perform all the processing required for an abort point.
function To_Duration (T : Time) return Duration;
+ -- Convert Time to Duration
end Ada.Calendar.Delays;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 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- --
-- The following constants are used in adjusting Ada dates so that they
-- fit into a 56 year range that can be handled by Unix (1970 included -
-- 2026 excluded). Dates that are not in this 56 year range are shifted
- -- by multiples of 56 years to fit in this range
+ -- by multiples of 56 years to fit in this range.
+
-- The trick is that the number of days in any four year period in the Ada
-- range of years (1901 - 2099) has a constant number of days. This is
-- because we have the special case of 2000 which, contrary to the normal
- -- exception for centuries, is a leap year after all.
- -- 56 has been chosen, because it is not only a multiple of 4, but also
- -- a multiple of 7. Thus two dates 56 years apart fall on the same day of
- -- the week, and the Daylight Saving Time change dates are usually the same
- -- for these two years.
+ -- exception for centuries, is a leap year after all. 56 has been chosen,
+ -- because it is not only a multiple of 4, but also a multiple of 7. Thus
+ -- two dates 56 years apart fall on the same day of the week, and the
+ -- Daylight Saving Time change dates are usually the same for these two
+ -- years.
Unix_Year_Min : constant := 1970;
Unix_Year_Max : constant := 2026;
pragma Unsuppress (Overflow_Check);
begin
return (Left + Time (Right));
-
exception
when Constraint_Error =>
raise Time_Error;
pragma Unsuppress (Overflow_Check);
begin
return (Time (Left) + Right);
-
exception
when Constraint_Error =>
raise Time_Error;
pragma Unsuppress (Overflow_Check);
begin
return Left - Time (Right);
-
exception
when Constraint_Error =>
raise Time_Error;
pragma Unsuppress (Overflow_Check);
begin
return Duration (Left) - Duration (Right);
-
exception
when Constraint_Error =>
raise Time_Error;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
-
begin
Split (Date, DY, DM, DD, DS);
return DD;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
-
begin
Split (Date, DY, DM, DD, DS);
return DM;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
-
begin
Split (Date, DY, DM, DD, DS);
return DS;
D := Duration (Date);
- -- First of all, filter out completely ludicrous values. Remember
- -- that we use the full stored range of duration values, which may
- -- be significantly larger than the allowed range of Ada times. Note
- -- that these checks are wider than required to make absolutely sure
- -- that there are no end effects from time zone differences.
+ -- First of all, filter out completely ludicrous values. Remember that
+ -- we use the full stored range of duration values, which may be
+ -- significantly larger than the allowed range of Ada times. Note that
+ -- these checks are wider than required to make absolutely sure that
+ -- there are no end effects from time zone differences.
if D < LowD or else D > HighD then
raise Time_Error;
-- required range of years (the guaranteed range available is only
-- EPOCH through EPOCH + N seconds). N is in practice 2 ** 31 - 1.
- -- If we have a value outside this range, then we first adjust it
- -- to be in the required range by adding multiples of 56 years.
- -- For the range we are interested in, the number of days in any
- -- consecutive 56 year period is constant. Then we do the split
- -- on the adjusted value, and readjust the years value accordingly.
+ -- If we have a value outside this range, then we first adjust it to be
+ -- in the required range by adding multiples of 56 years. For the range
+ -- we are interested in, the number of days in any consecutive 56 year
+ -- period is constant. Then we do the split on the adjusted value, and
+ -- readjust the years value accordingly.
Year_Val := 0;
end loop;
-- Now we need to take the value D, which is now non-negative, and
- -- break it down into seconds (to pass to the localtime_r function)
- -- and fractions of seconds (for the adjustment below).
+ -- break it down into seconds (to pass to the localtime_r function) and
+ -- fractions of seconds (for the adjustment below).
-- Surprisingly there is no easy way to do this in Ada, and certainly
- -- no easy way to do it and generate efficient code. Therefore we
- -- do it at a low level, knowing that it is really represented as
- -- an integer with units of Small
+ -- no easy way to do it and generate efficient code. Therefore we do it
+ -- at a low level, knowing that it is really represented as an integer
+ -- with units of Small
declare
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
Day := Tm_Val.tm_mday;
-- The Seconds value is a little complex. The localtime function
- -- returns the integral number of seconds, which is what we want,
- -- but we want to retain the fractional part from the original
- -- Time value, since this is typically stored more accurately.
+ -- returns the integral number of seconds, which is what we want, but
+ -- we want to retain the fractional part from the original Time value,
+ -- since this is typically stored more accurately.
Seconds := Duration (Tm_Val.tm_hour * 3600 +
Tm_Val.tm_min * 60 +
Tm_Val.tm_sec)
+ Frac_Sec;
- -- Note: the above expression is pretty horrible, one of these days
- -- we should stop using time_of and do everything ourselves to avoid
- -- these unnecessary divides and multiplies???.
+ -- Note: the above expression is pretty horrible, one of these days we
+ -- should stop using time_of and do everything ourselves to avoid these
+ -- unnecessary divides and multiplies???.
-- The Year may still be out of range, since our entry test was
-- deliberately crude. Trying to make this entry test accurate is
begin
-- The following checks are redundant with respect to the constraint
-- error checks that should normally be made on parameters, but we
- -- decide to raise Constraint_Error in any case if bad values come
- -- in (as a result of checks being off in the caller, or for other
+ -- decide to raise Constraint_Error in any case if bad values come in
+ -- (as a result of checks being off in the caller, or for other
-- erroneous or bounded error cases).
if not Year 'Valid
TM_Val.tm_mon := Month - 1;
-- For the year, we have to adjust it to a year that Unix can handle.
- -- We do this in 56 year steps, since the number of days in 56 years
- -- is constant, so the timezone effect on the conversion from local
- -- time to GMT is unaffected; also the DST change dates are usually
- -- not modified.
+ -- We do this in 56 year steps, since the number of days in 56 years is
+ -- constant, so the timezone effect on the conversion from local time
+ -- to GMT is unaffected; also the DST change dates are usually not
+ -- modified.
while Year_Val < Unix_Year_Min loop
Year_Val := Year_Val + 56;
TM_Val.tm_year := Year_Val - 1900;
- -- Since we do not have information on daylight savings,
- -- rely on the default information.
+ -- Since we do not have information on daylight savings, rely on the
+ -- default information.
TM_Val.tm_isdst := -1;
Result_Secs := mktime (TM_Val'Unchecked_Access);
-- That gives us the basic value in seconds. Two adjustments are
-- needed. First we must undo the year adjustment carried out above.
-- Second we put back the fraction seconds value since in general the
- -- Day_Duration value we received has additional precision which we
- -- do not want to lose in the constructed result.
+ -- Day_Duration value we received has additional precision which we do
+ -- not want to lose in the constructed result.
return
Time (Duration (Result_Secs) +
Duration_Adjust +
(Seconds - Duration (Int_Secs)));
-
end Time_Of;
----------
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
-
begin
Split (Date, DY, DM, DD, DS);
return DY;
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2004, Ada Core Technologies --
+-- Copyright (C) 1995-2005, Ada Core Technologies --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- The following notes are provided in case someone decides the
--- implementation of this package is too complicated, or too slow.
--- Please read this before making any "simplifications".
+-- The following notes are provided in case someone decides the implementation
+-- of this package is too complicated, or too slow. Please read this before
+-- making any "simplifications".
--- Correct implementation of this package is more difficult than one
--- might expect. After considering (and coding) several alternatives,
--- we settled on the present compromise. Things we do not like about
--- this implementation include:
+-- Correct implementation of this package is more difficult than one might
+-- expect. After considering (and coding) several alternatives, we settled on
+-- the present compromise. Things we do not like about this implementation
+-- include:
--- - It is vulnerable to bad Task_Id values, to the extent of
--- possibly trashing memory and crashing the runtime system.
+-- - It is vulnerable to bad Task_Id values, to the extent of possibly
+-- trashing memory and crashing the runtime system.
--- - It requires dynamic storage allocation for each new attribute value,
--- except for types that happen to be the same size as System.Address,
--- or shorter.
+-- - It requires dynamic storage allocation for each new attribute value,
+-- except for types that happen to be the same size as System.Address, or
+-- shorter.
-- - Instantiations at other than the library level rely on being able to
-- do down-level calls to a procedure declared in the generic package body.
-- This makes it potentially vulnerable to compiler changes.
--- The main implementation issue here is that the connection from
--- task to attribute is a potential source of dangling references.
+-- The main implementation issue here is that the connection from task to
+-- attribute is a potential source of dangling references.
-- When a task goes away, we want to be able to recover all the storage
-- associated with its attributes. The Ada mechanism for this is
--- finalization, via controlled attribute types. For this reason,
--- the ARM requires finalization of attribute values when the
--- associated task terminates.
+-- finalization, via controlled attribute types. For this reason, the ARM
+-- requires finalization of attribute values when the associated task
+-- terminates.
--- This finalization must be triggered by the tasking runtime system,
--- during termination of the task. Given the active set of instantiations
--- of Ada.Task_Attributes is dynamic, the number and types of attributes
+-- This finalization must be triggered by the tasking runtime system, during
+-- termination of the task. Given the active set of instantiations of
+-- Ada.Task_Attributes is dynamic, the number and types of attributes
-- belonging to a task will not be known until the task actually terminates.
-- Some of these types may be controlled and some may not. The RTS must find
-- some way to determine which of these attributes need finalization, and
-- invoke the appropriate finalization on them.
--- One way this might be done is to create a special finalization chain
--- for each task, similar to the finalization chain that is used for
--- controlled objects within the task. This would differ from the usual
--- finalization chain in that it would not have a LIFO structure, since
--- attributes may be added to a task at any time during its lifetime.
--- This might be the right way to go for the longer term, but at present
--- this approach is not open, since GNAT does not provide such special
--- finalization support.
+-- One way this might be done is to create a special finalization chain for
+-- each task, similar to the finalization chain that is used for controlled
+-- objects within the task. This would differ from the usual finalization
+-- chain in that it would not have a LIFO structure, since attributes may be
+-- added to a task at any time during its lifetime. This might be the right
+-- way to go for the longer term, but at present this approach is not open,
+-- since GNAT does not provide such special finalization support.
--- Lacking special compiler support, the RTS is limited to the
--- normal ways an application invokes finalization, i.e.
+-- Lacking special compiler support, the RTS is limited to the normal ways an
+-- application invokes finalization, i.e.
--- a) Explicit call to the procedure Finalize, if we know the type
--- has this operation defined on it. This is not sufficient, since
--- we have no way of determining whether a given generic formal
--- Attribute type is controlled, and no visibility of the associated
--- Finalize procedure, in the generic body.
+-- a) Explicit call to the procedure Finalize, if we know the type has this
+-- operation defined on it. This is not sufficient, since we have no way
+-- of determining whether a given generic formal Attribute type is
+-- controlled, and no visibility of the associated Finalize procedure, in
+-- the generic body.
--- b) Leaving the scope of a local object of a controlled type.
--- This does not help, since the lifetime of an instantiation of
--- Ada.Task_Attributes does not correspond to the lifetimes of the
--- various tasks which may have that attribute.
+-- b) Leaving the scope of a local object of a controlled type. This does not
+-- help, since the lifetime of an instantiation of Ada.Task_Attributes
+-- does not correspond to the lifetimes of the various tasks which may
+-- have that attribute.
--- c) Assignment of another value to the object. This would not help,
--- since we then have to finalize the new value of the object.
+-- c) Assignment of another value to the object. This would not help, since
+-- we then have to finalize the new value of the object.
--- d) Unchecked deallocation of an object of a controlled type.
--- This seems to be the only mechanism available to the runtime
--- system for finalization of task attributes.
+-- d) Unchecked deallocation of an object of a controlled type. This seems to
+-- be the only mechanism available to the runtime system for finalization
+-- of task attributes.
--- We considered two ways of using unchecked deallocation, both based
--- on a linked list of that would hang from the task control block.
+-- We considered two ways of using unchecked deallocation, both based on a
+-- linked list of that would hang from the task control block.
-- In the first approach the objects on the attribute list are all derived
-- from one controlled type, say T, and are linked using an access type to
--- T'Class. The runtime system has an Unchecked_Deallocation for T'Class
--- with access type T'Class, and uses this to deallocate and finalize all
--- the items in the list. The limitation of this approach is that each
+-- T'Class. The runtime system has an Unchecked_Deallocation for T'Class with
+-- access type T'Class, and uses this to deallocate and finalize all the
+-- items in the list. The limitation of this approach is that each
-- instantiation of the package Ada.Task_Attributes derives a new record
--- extension of T, and since T is controlled (RM 3.9.1 (3)), instantiation
--- is only allowed at the library level.
-
--- In the second approach the objects on the attribute list are of
--- unrelated but structurally similar types. Unchecked conversion is
--- used to circument Ada type checking. Each attribute-storage node
--- contains not only the attribute value and a link for chaining, but
--- also a pointer to a descriptor for the corresponding instantiation
--- of Task_Attributes. The instantiation-descriptor contains a
--- pointer to a procedure that can do the correct deallocation and
--- finalization for that type of attribute. On task termination, the
--- runtime system uses the pointer to call the appropriate deallocator.
-
--- While this gets around the limitation that instantations be at
--- the library level, it relies on an implementation feature that
--- may not always be safe, i.e. that it is safe to call the
--- Deallocate procedure for an instantiation of Ada.Task_Attributes
--- that no longer exists. In general, it seems this might result in
--- dangling references.
-
--- Another problem with instantiations deeper than the library level
--- is that there is risk of storage leakage, or dangling references
--- to reused storage. That is, if an instantiation of Ada.Task_Attributes
--- is made within a procedure, what happens to the storage allocated for
--- attributes, when the procedure call returns? Apparently (RM 7.6.1 (4))
--- any such objects must be finalized, since they will no longer be
--- accessible, and in general one would expect that the storage they occupy
--- would be recovered for later reuse. (If not, we would have a case of
--- storage leakage.) Assuming the storage is recovered and later reused,
--- we have potentially dangerous dangling references. When the procedure
--- containing the instantiation of Ada.Task_Attributes returns, there
--- may still be unterminated tasks with associated attribute values for
--- that instantiation. When such tasks eventually terminate, the RTS
--- will attempt to call the Deallocate procedure on them. If the
--- corresponding storage has already been deallocated, when the master
--- of the access type was left, we have a potential disaster. This
--- disaster is compounded since the pointer to Deallocate is probably
--- through a "trampoline" which will also have been destroyed.
-
--- For this reason, we arrange to remove all dangling references
--- before leaving the scope of an instantiation. This is ugly, since
--- it requires traversing the list of all tasks, but it is no more ugly
--- than a similar traversal that we must do at the point of instantiation
--- in order to initialize the attributes of all tasks. At least we only
--- need to do these traversals if the type is controlled.
-
--- We chose to defer allocation of storage for attributes until the
--- Reference function is called or the attribute is first set to a value
--- different from the default initial one. This allows a potential
--- savings in allocation, for attributes that are not used by all tasks.
+-- extension of T, and since T is controlled (RM 3.9.1 (3)), instantiation is
+-- only allowed at the library level.
+
+-- In the second approach the objects on the attribute list are of unrelated
+-- but structurally similar types. Unchecked conversion is used to circument
+-- Ada type checking. Each attribute-storage node contains not only the
+-- attribute value and a link for chaining, but also a pointer to descriptor
+-- for the corresponding instantiation of Task_Attributes. The instantiation
+-- descriptor contains pointer to a procedure that can do the correct
+-- deallocation and finalization for that type of attribute. On task
+-- termination, the runtime system uses the pointer to call the appropriate
+-- deallocator.
+
+-- While this gets around the limitation that instantations be at the library
+-- level, it relies on an implementation feature that may not always be safe,
+-- i.e. that it is safe to call the Deallocate procedure for an instantiation
+-- of Ada.Task_Attributes that no longer exists. In general, it seems this
+-- might result in dangling references.
+
+-- Another problem with instantiations deeper than the library level is that
+-- there is risk of storage leakage, or dangling references to reused
+-- storage. That is, if an instantiation of Ada.Task_Attributes is made
+-- within a procedure, what happens to the storage allocated for attributes,
+-- when the procedure call returns? Apparently (RM 7.6.1 (4)) any such
+-- objects must be finalized, since they will no longer be accessible, and in
+-- general one would expect that the storage they occupy would be recovered
+-- for later reuse. (If not, we would have a case of storage leakage.)
+-- Assuming the storage is recovered and later reused, we have potentially
+-- dangerous dangling references. When the procedure containing the
+-- instantiation of Ada.Task_Attributes returns, there may still be
+-- unterminated tasks with associated attribute values for that instantiation.
+-- When such tasks eventually terminate, the RTS will attempt to call the
+-- Deallocate procedure on them. If the corresponding storage has already
+-- been deallocated, when the master of the access type was left, we have a
+-- potential disaster. This disaster is compounded since the pointer to
+-- Deallocate is probably through a "trampoline" which will also have been
+-- destroyed.
+
+-- For this reason, we arrange to remove all dangling references before
+-- leaving the scope of an instantiation. This is ugly, since it requires
+-- traversing the list of all tasks, but it is no more ugly than a similar
+-- traversal that we must do at the point of instantiation in order to
+-- initialize the attributes of all tasks. At least we only need to do these
+-- traversals if the type is controlled.
+
+-- We chose to defer allocation of storage for attributes until the Reference
+-- function is called or the attribute is first set to a value different from
+-- the default initial one. This allows a potential savings in allocation,
+-- for attributes that are not used by all tasks.
-- For efficiency, we reserve space in the TCB for a fixed number of
--- direct-access attributes. These are required to be of a size that
--- fits in the space of an object of type System.Address. Because
--- we must use unchecked bitwise copy operations on these values, they
--- cannot be of a controlled type, but that is covered automatically
--- since controlled objects are too large to fit in the spaces.
+-- direct-access attributes. These are required to be of a size that fits in
+-- the space of an object of type System.Address. Because we must use
+-- unchecked bitwise copy operations on these values, they cannot be of a
+-- controlled type, but that is covered automatically since controlled
+-- objects are too large to fit in the spaces.
-- We originally deferred the initialization of these direct-access
--- attributes, just as we do for the indirect-access attributes, and
--- used a per-task bit vector to keep track of which attributes were
--- currently defined for that task. We found that the overhead of
--- maintaining this bit-vector seriously slowed down access to the
--- attributes, and made the fetch operation non-atomic, so that even
--- to read an attribute value required locking the TCB. Therefore,
--- we now initialize such attributes for all existing tasks at the time
--- of the attribute instantiation, and initialize existing attributes
--- for each new task at the time it is created.
+-- attributes, just as we do for the indirect-access attributes, and used a
+-- per-task bit vector to keep track of which attributes were currently
+-- defined for that task. We found that the overhead of maintaining this
+-- bit-vector seriously slowed down access to the attributes, and made the
+-- fetch operation non-atomic, so that even to read an attribute value
+-- required locking the TCB. Therefore, we now initialize such attributes for
+-- all existing tasks at the time of the attribute instantiation, and
+-- initialize existing attributes for each new task at the time it is
+-- created.
-- The latter initialization requires a list of all the instantiation
--- descriptors. Updates to this list, as well as the bit-vector that
--- is used to reserve slots for attributes in the TCB, require mutual
--- exclusion. That is provided by the Lock/Unlock_RTS.
-
--- One special problem that added complexity to the design is that
--- the per-task list of indirect attributes contains objects of
--- different types. We use unchecked pointer conversion to link
--- these nodes together and access them, but the records may not have
--- identical internal structure. Initially, we thought it would be
--- enough to allocate all the common components of the records at the
--- front of each record, so that their positions would correspond.
--- Unfortunately, GNAT adds "dope" information at the front of a record,
--- if the record contains any controlled-type components.
+-- descriptors. Updates to this list, as well as the bit-vector that is used
+-- to reserve slots for attributes in the TCB, require mutual exclusion. That
+-- is provided by the Lock/Unlock_RTS.
+
+-- One special problem that added complexity to the design is that the
+-- per-task list of indirect attributes contains objects of different types.
+-- We use unchecked pointer conversion to link these nodes together and
+-- access them, but the records may not have identical internal structure.
+-- Initially, we thought it would be enough to allocate all the common
+-- components of the records at the front of each record, so that their
+-- positions would correspond. Unfortunately, GNAT adds "dope" information at
+-- the front of a record, if the record contains any controlled-type
+-- components.
--
--- This means that the offset of the fields we use to link the nodes is
--- at different positions on nodes of different types. To get around this,
--- each attribute storage record consists of a core node and wrapper.
--- The core nodes are all of the same type, and it is these that are
--- linked together and generally "seen" by the RTS. Each core node
--- contains a pointer to its own wrapper, which is a record that contains
--- the core node along with an attribute value, approximately
--- as follows:
+-- This means that the offset of the fields we use to link the nodes is at
+-- different positions on nodes of different types. To get around this, each
+-- attribute storage record consists of a core node and wrapper. The core
+-- nodes are all of the same type, and it is these that are linked together
+-- and generally "seen" by the RTS. Each core node contains a pointer to its
+-- own wrapper, which is a record that contains the core node along with an
+-- attribute value, approximately as follows:
-- type Node;
-- type Node_Access is access all Node;
-- Wrapper : Access_Wrapper;
-- end record;
-- type Wrapper is record
--- Noed : aliased Node;
--- Value : aliased Attribute; -- the generic formal type
+-- Dummy_Node : aliased Node;
+-- Value : aliased Attribute; -- the generic formal type
-- end record;
--- Another interesting problem is with the initialization of
--- the instantiation descriptors. Originally, we did this all via
--- the Initialize procedure of the descriptor type and code in the
--- package body. It turned out that the Initialize procedure needed
--- quite a bit of information, including the size of the attribute
--- type, the initial value of the attribute (if it fits in the TCB),
--- and a pointer to the deallocator procedure. These needed to be
--- "passed" in via access discriminants. GNAT was having trouble
--- with access discriminants, so all this work was moved to the
--- package body.
+-- Another interesting problem is with the initialization of the
+-- instantiation descriptors. Originally, we did this all via the Initialize
+-- procedure of the descriptor type and code in the package body. It turned
+-- out that the Initialize procedure needed quite a bit of information,
+-- including the size of the attribute type, the initial value of the
+-- attribute (if it fits in the TCB), and a pointer to the deallocator
+-- procedure. These needed to be "passed" in via access discriminants. GNAT
+-- was having trouble with access discriminants, so all this work was moved
+-- to the package body.
with Ada.Task_Identification;
--- used for Task_Id
+-- Used for Task_Id
-- Null_Task_Id
-- Current_Task
with System.Error_Reporting;
--- used for Shutdown;
+-- Used for Shutdown;
with System.Storage_Elements;
--- used for Integer_Address
+-- Used for Integer_Address
with System.Task_Primitives.Operations;
--- used for Write_Lock
+-- Used for Write_Lock
-- Unlock
-- Lock/Unlock_RTS
with System.Tasking;
--- used for Access_Address
+-- Used for Access_Address
-- Task_Id
-- Direct_Index_Vector
-- Direct_Index
with System.Tasking.Initialization;
--- used for Defer_Abortion
+-- Used for Defer_Abortion
-- Undefer_Abortion
-- Initialize_Attributes_Link
-- Finalize_Attributes_Link
with System.Tasking.Task_Attributes;
--- used for Access_Node
+-- Used for Access_Node
-- Access_Dummy_Wrapper
-- Deallocator
-- Instance
-- Access_Instance
with Ada.Exceptions;
--- used for Raise_Exception
+-- Used for Raise_Exception
with Unchecked_Conversion;
with Unchecked_Deallocation;
pragma Elaborate_All (System.Tasking.Task_Attributes);
--- to ensure the initialization of object Local (below) will work
+-- To ensure the initialization of object Local (below) will work
package body Ada.Task_Attributes is
pragma Warnings (Off);
-- We turn warnings off for the following declarations of the
- -- To_Attribute_Handle conversions, since these are used only
- -- for small attributes where we know that there are no problems
- -- with alignment, but the compiler will generate warnings for
- -- the occurrences in the large attribute case, even though
- -- they will not actually be used.
+ -- To_Attribute_Handle conversions, since these are used only for small
+ -- attributes where we know that there are no problems with alignment, but
+ -- the compiler will generate warnings for the occurrences in the large
+ -- attribute case, even though they will not actually be used.
function To_Attribute_Handle is new Unchecked_Conversion
(System.Address, Attribute_Handle);
(Access_Dummy_Wrapper, Access_Wrapper);
pragma Warnings (On);
-- To fetch pointer to actual wrapper of attribute node. We turn off
- -- warnings since this may generate an alignment warning. The warning
- -- can be ignored since Dummy_Wrapper is only a non-generic standin
- -- for the real wrapper type (we never actually allocate objects of
- -- type Dummy_Wrapper).
+ -- warnings since this may generate an alignment warning. The warning can
+ -- be ignored since Dummy_Wrapper is only a non-generic standin for the
+ -- real wrapper type (we never actually allocate objects of type
+ -- Dummy_Wrapper).
function To_Access_Dummy_Wrapper is new Unchecked_Conversion
(Access_Wrapper, Access_Dummy_Wrapper);
-- Initialized in package body
type Wrapper is record
- Noed : aliased Node;
+ Dummy_Node : aliased Node;
Value : aliased Attribute := Initial_Value;
-- The generic formal type, may be controlled
((null, Local'Unchecked_Access, null), Initial_Value);
POP.Lock_RTS;
- P := W.Noed'Unchecked_Access;
+ P := W.Dummy_Node'Unchecked_Access;
P.Wrapper := To_Access_Dummy_Wrapper (W);
P.Next := To_Access_Node (TT.Indirect_Attributes);
TT.Indirect_Attributes := To_Access_Address (P);
P := P.Next;
end loop;
- -- Unlock RTS here to follow the lock ordering rule that
- -- prevent us from using new (i.e the Global_Lock) while
- -- holding any other lock.
+ -- Unlock RTS here to follow the lock ordering rule that prevent us
+ -- from using new (i.e the Global_Lock) while holding any other
+ -- lock.
POP.Unlock_RTS;
W := new Wrapper'((null, Local'Unchecked_Access, null), Val);
POP.Lock_RTS;
- P := W.Noed'Unchecked_Access;
+ P := W.Dummy_Node'Unchecked_Access;
P.Wrapper := To_Access_Dummy_Wrapper (W);
P.Next := To_Access_Node (TT.Indirect_Attributes);
TT.Indirect_Attributes := To_Access_Address (P);
if Local.Index /= 0 then
-- Get value of attribute. Warnings off, because for large
- -- attributes, this code can generate alignment warnings.
- -- But of course large attributes are never directly addressed
- -- so in fact we will never execute the code in this case.
+ -- attributes, this code can generate alignment warnings. But of
+ -- course large attributes are never directly addressed so in fact
+ -- we will never execute the code in this case.
pragma Warnings (Off);
return To_Attribute_Handle
POP.Lock_RTS;
- -- Add this instantiation to the list of all instantiations.
+ -- Add this instantiation to the list of all instantiations
Local.Next := System.Tasking.Task_Attributes.All_Attributes;
System.Tasking.Task_Attributes.All_Attributes :=
Local'Unchecked_Access;
- -- Try to find space for the attribute in the TCB.
+ -- Try to find space for the attribute in the TCB
Local.Index := 0;
Two_To_J := 1;
In_Use := In_Use or Two_To_J;
Local.Index := J;
- -- This unchecked conversions can give a warning when the
- -- the alignment is incorrect, but it will not be used in
- -- such a case anyway, so the warning can be safely ignored.
+ -- This unchecked conversions can give a warning when the the
+ -- alignment is incorrect, but it will not be used in such a
+ -- case anyway, so the warning can be safely ignored.
pragma Warnings (Off);
To_Attribute_Handle (Local.Initial_Value'Access).all :=
-- Attribute goes directly in the TCB
if Local.Index /= 0 then
- -- Replace stub for initialization routine
- -- that is called at task creation.
+ -- Replace stub for initialization routine that is called at task
+ -- creation.
Initialization.Initialize_Attributes_Link :=
System.Tasking.Task_Attributes.Initialize_Attributes'Access;
- -- Initialize the attribute, for all tasks.
+ -- Initialize the attribute, for all tasks
declare
C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List;
-- Attribute goes into a node onto a linked list
else
- -- Replace stub for finalization routine
- -- that is called at task termination.
+ -- Replace stub for finalization routine that is called at task
+ -- termination.
Initialization.Finalize_Attributes_Link :=
System.Tasking.Task_Attributes.Finalize_Attributes'Access;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 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- --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- Extensive contributions were provided by AdaCore. --
-- --
------------------------------------------------------------------------------
-- the cause of the compiler abort and about the preferred method
-- of reporting bugs. The default is a bug box appropriate for
-- the FSF version of GNAT, but there are specializations for
- -- the GNATPRO and Public releases by Ada Core Technologies.
+ -- the GNATPRO and Public releases by AdaCore.
procedure End_Line;
-- Add blanks up to column 76, and then a final vertical bar
Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
- Is_GAP_Version : constant Boolean := Get_Gnat_Build_Type = GAP;
-- Start of processing for Compiler_Abort
" http://gcc.gnu.org/bugs.html.");
End_Line;
+ elsif Is_Public_Version then
+ Write_Str
+ ("| submit bug report by email " &
+ "to report@adacore.com.");
+ End_Line;
+
+ Write_Str
+ ("| See gnatinfo.txt for full info on procedure " &
+ "for submitting bugs.");
+ End_Line;
+
else
Write_Str
- ("| Please submit bug report by email " &
- "to report@gnat.com.");
+ ("| Please submit a bug report using GNAT Tracker:");
End_Line;
Write_Str
- ("| Use a subject line meaningful to you" &
- " and us to track the bug.");
+ ("| http://www.adacore.com/gnattracker/ " &
+ "section 'send a report'.");
+ End_Line;
+
+ Write_Str
+ ("| alternatively submit a bug report by email " &
+ "to report@adacore.com.");
End_Line;
end if;
+
+ Write_Str
+ ("| Use a subject line meaningful to you" &
+ " and us to track the bug.");
+ End_Line;
+
if not (Is_Public_Version or Is_FSF_Version) then
Write_Str
- ("| (include your customer number #nnn " &
- "in the subject line).");
+ ("| Include your customer number #nnn " &
+ "in the subject line.");
End_Line;
end if;
("| (concatenated together with no headers between files).");
End_Line;
- if Is_Public_Version then
+ if not Is_FSF_Version then
Write_Str
- ("| (use plain ASCII or MIME attachment).");
- End_Line;
-
- Write_Str
- ("| See gnatinfo.txt for full info on procedure " &
- "for submitting bugs.");
- End_Line;
-
- elsif Is_GAP_Version then
- Write_Str
- ("| (use plain ASCII or MIME attachment, or FTP "
- & "to your GAP account.).");
- End_Line;
-
- Write_Str
- ("| Please use your GAP account to report this.");
- End_Line;
-
- elsif not Is_FSF_Version then
- Write_Str
- ("| (use plain ASCII or MIME attachment, or FTP "
- & "to your customer directory).");
- End_Line;
-
- Write_Str
- ("| See README.GNATPRO for full info on procedure " &
- "for submitting bugs.");
+ ("| Use plain ASCII or MIME attachment.");
End_Line;
end if;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2005 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- --
(Left : Address;
Llen : Natural;
Right : Address;
- Rlen : Natural)
- return Boolean
+ Rlen : Natural) return Boolean
is
LeftB : constant Bits := To_Bits (Left);
RightB : constant Bits := To_Bits (Right);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
-- Note: in all the following routines, the System.Address parameters
-- represent the address of the first byte of an array used to represent
-- a packed array (of type System.Unsigned_Types.Packed_Bytes{1,2,4})
- -- The length in bits is passed as a separate parameter.
+ -- The length in bits is passed as a separate parameter. Note that all
+ -- addresses must be of byte aligned arrays.
procedure Bit_And
(Left : System.Address;
(Left : System.Address;
Llen : Natural;
Right : System.Address;
- Rlen : Natural)
- return Boolean;
+ Rlen : Natural) return Boolean;
-- Left and Right are the addresses of two bit packed arrays with Llen
-- and Rlen being the respective length in bits. The routine compares the
-- two bit strings for equality, being careful not to include the unused
function opendir (file_name : String) return DIRs;
pragma Import (C, opendir, "opendir");
+ function pclose (stream : System.Address) return int;
+ pragma Import (C, pclose, "pclose");
+
+ function popen (command, mode : System.Address) return System.Address;
+ pragma Import (C, popen, "popen");
+
function read (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, read, "read");
procedure Finalize_Global_List is
begin
-- There are three case here:
+
-- a. the application uses tasks, in which case Finalize_Global_Tasks
- -- will defer abortion
+ -- will defer abort.
+
-- b. the application doesn't use tasks but uses other tasking
-- constructs, such as ATCs and protected objects. In this case,
-- the binder will call Finalize_Global_List instead of
-- Finalize_Global_Tasks, letting abort undeferred, and leading
-- to assertion failures in the GNULL
+
-- c. the application doesn't use any tasking construct in which case
-- deferring abort isn't necessary.
- --
+
-- Until another solution is found to deal with case b, we need to
-- call abort_defer here to pass the checks, but we do not need to
- -- undefer abortion, since Finalize_Global_List is the last procedure
+ -- undefer abort, since Finalize_Global_List is the last procedure
-- called before exiting the partition.
SSL.Abort_Defer.all;
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This is the Alpha/VMS version of this package.
---
--- This package encapsulates and centralizes information about
--- all uses of interrupts (or signals), including the
--- target-dependent mapping of interrupts (or signals) to exceptions.
+-- This is the Alpha/VMS version of this package
--- PLEASE DO NOT add any with-clauses to this package.
--- This is designed to work for both tasking and non-tasking systems,
--- without pulling in any of the tasking support.
+-- This package encapsulates and centralizes information about all uses of
+-- interrupts (or signals), including the target-dependent mapping of
+-- interrupts (or signals) to exceptions.
+
+-- PLEASE DO NOT add any with-clauses to this package
+
+-- This is designed to work for both tasking and non-tasking systems, without
+-- pulling in any of the tasking support.
-- PLEASE DO NOT remove the Elaborate_Body pragma from this package.
-- Elaboration of this package should happen early, as most other
--- initializations depend on it.
--- Forcing immediate elaboration of the body also helps to enforce
--- the design assumption that this is a second-level
--- package, just one level above System.OS_Interface, with no
--- cross-dependences.
-
--- PLEASE DO NOT put any subprogram declarations with arguments of
--- type Interrupt_ID into the visible part of this package.
--- The type Interrupt_ID is used to derive the type in Ada.Interrupts,
--- and adding more operations to that type would be illegal according
--- to the Ada Reference Manual. (This is the reason why the signals sets
--- below are implemented as visible arrays rather than functions.)
+
+-- Forcing immediate elaboration of the body also helps to enforce the design
+-- assumption that this is a second-level package, just one level above
+-- System.OS_Interface, with no cross-dependences.
+
+-- PLEASE DO NOT put any subprogram declarations with arguments of type
+-- Interrupt_ID into the visible part of this package.
+
+-- The type Interrupt_ID is used to derive the type in Ada.Interrupts, and
+-- adding more operations to that type would be illegal according to the Ada
+-- Reference Manual. (This is the reason why the signals sets below are
+-- implemented as visible arrays rather than functions.)
with System.OS_Interface;
-- used for Signal
type Interrupt_Set is array (Interrupt_ID) of Boolean;
- -- The following objects serve as constants, but are initialized
- -- in the body to aid portability. This permits us
- -- to use more portable names for interrupts,
- -- where distinct names may map to the same interrupt ID value.
- -- For example, suppose SIGRARE is a signal that is not defined on
- -- all systems, but is always reserved when it is defined.
- -- If we have the convention that ID zero is not used for any "real"
- -- signals, and SIGRARE = 0 when SIGRARE is not one of the locally
- -- supported signals, we can write
+ -- The following objects serve as constants, but are initialized in the
+ -- body to aid portability. This permits us to use more portable names for
+ -- interrupts, where distinct names may map to the same interrupt ID
+ -- value. For example, suppose SIGRARE is a signal that is not defined on
+ -- all systems, but is always reserved when it is defined. If we have the
+ -- convention that ID zero is not used for any "real" signals, and SIGRARE
+ -- = 0 when SIGRARE is not one of the locally supported signals, we can
+ -- write
+
-- Reserved (SIGRARE) := true;
- -- and the initialization code will be portable.
+
+ -- Then the initialization code will be portable
Abort_Task_Interrupt : Interrupt_ID;
- -- The interrupt that is used to implement task abortion,
- -- if an interrupt is used for that purpose.
- -- This is one of the reserved interrupts.
+ -- The interrupt that is used to implement task abort, if an interrupt is
+ -- used for that purpose. This is one of the reserved interrupts.
Keep_Unmasked : Interrupt_Set := (others => False);
- -- Keep_Unmasked (I) is true iff the interrupt I is
- -- one that must be kept unmasked at all times,
- -- except (perhaps) for short critical sections.
- -- This includes interrupts that are mapped to exceptions
- -- (see System.Interrupt_Exceptions.Is_Exception), but may also
- -- include interrupts (e.g. timer) that need to be kept unmasked
- -- for other reasons.
- -- Where interrupts are implemented as OS signals, and signal masking
- -- is per-task, the interrupt should be unmasked in ALL TASKS.
+ -- Keep_Unmasked (I) is true iff the interrupt I is one that must be kept
+ -- unmasked at all times, except (perhaps) for short critical sections.
+ -- This includes interrupts that are mapped to exceptions (see
+ -- System.Interrupt_Exceptions.Is_Exception), but may also include
+ -- interrupts (e.g. timer) that need to be kept unmasked for other
+ -- reasons. Where interrupts are implemented as OS signals, and signal
+ -- masking is per-task, the interrupt should be unmasked in ALL TASKS.
Reserve : Interrupt_Set := (others => False);
- -- Reserve (I) is true iff the interrupt I is one that
- -- cannot be permitted to be attached to a user handler.
- -- The possible reasons are many. For example,
- -- it may be mapped to an exception, used to implement task abortion,
- -- or used to implement time delays.
+ -- Reserve (I) is true iff the interrupt I is one that cannot be permitted
+ -- to be attached to a user handler. The possible reasons are many. For
+ -- example it may be mapped to an exception used to implement task abort.
Keep_Masked : Interrupt_Set := (others => False);
-- Keep_Masked (I) is true iff the interrupt I must always be masked.
- -- Where interrupts are implemented as OS signals, and signal masking
- -- is per-task, the interrupt should be masked in ALL TASKS.
- -- There might not be any interrupts in this class, depending on
- -- the environment. For example, if interrupts are OS signals
- -- and signal masking is per-task, use of the sigwait operation
- -- requires the signal be masked in all tasks.
+ -- Where interrupts are implemented as OS signals, and signal masking is
+ -- per-task, the interrupt should be masked in ALL TASKS. There might not
+ -- be any interrupts in this class, depending on the environment. For
+ -- example, if interrupts are OS signals and signal masking is per-task,
+ -- use of the sigwait operation requires the signal be masked in all tasks.
procedure Initialize_Interrupts;
-- On systems where there is no signal inheritance between tasks (e.g
-- only be called by initialize in this package body.
private
-
use type System.OS_Interface.unsigned_long;
type Interrupt_Mask is new System.OS_Interface.sigset_t;
Rcv_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
Snd_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
Interrupt_Mailbox : Interrupt_ID := 0;
- Interrupt_Bufquo : System.OS_Interface.unsigned_long
- := 1000 * (Interrupt_ID'Size / 8);
+ Interrupt_Bufquo : System.OS_Interface.unsigned_long :=
+ 1000 * (Interrupt_ID'Size / 8);
end System.Interrupt_Management;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This is the VxWorks version of this package.
+-- This is the VxWorks version of this package
-- This package encapsulates and centralizes information about all
-- uses of interrupts (or signals), including the target-dependent
type Signal_Set is array (Signal_ID) of Boolean;
- -- The following objects serve as constants, but are initialized
- -- in the body to aid portability. This permits us to use more
- -- portable names for interrupts, where distinct names may map to
- -- the same interrupt ID value.
- --
- -- For example, suppose SIGRARE is a signal that is not defined on
- -- all systems, but is always reserved when it is defined. If we
- -- have the convention that ID zero is not used for any "real"
- -- signals, and SIGRARE = 0 when SIGRARE is not one of the locally
- -- supported signals, we can write
+ -- The following objects serve as constants, but are initialized in the
+ -- body to aid portability. This permits us to use more portable names for
+ -- interrupts, where distinct names may map to the same interrupt ID
+ -- value.
+
+ -- For example, suppose SIGRARE is a signal that is not defined on all
+ -- systems, but is always reserved when it is defined. If we have the
+ -- convention that ID zero is not used for any "real" signals, and SIGRARE
+ -- = 0 when SIGRARE is not one of the locally supported signals, we can
+ -- write:
+
-- Reserved (SIGRARE) := true;
+
-- and the initialization code will be portable.
Abort_Task_Signal : Signal_ID;
- -- The signal that is used to implement task abortion if
- -- an interrupt is used for that purpose. This is one of the
- -- reserved signals.
+ -- The signal that is used to implement task abort if an interrupt is used
+ -- for that purpose. This is one of the reserved signals.
Keep_Unmasked : Signal_Set := (others => False);
- -- Keep_Unmasked (I) is true iff the signal I is one that must
- -- that must be kept unmasked at all times, except (perhaps) for
- -- short critical sections. This includes signals that are
- -- mapped to exceptions, but may also include interrupts
- -- (e.g. timer) that need to be kept unmasked for other
- -- reasons. Where signal masking is per-task, the signal should be
+ -- Keep_Unmasked (I) is true iff the signal I is one that must that must
+ -- be kept unmasked at all times, except (perhaps) for short critical
+ -- sections. This includes signals that are mapped to exceptions, but may
+ -- also include interrupts (e.g. timer) that need to be kept unmasked for
+ -- other reasons. Where signal masking is per-task, the signal should be
-- unmasked in ALL TASKS.
Reserve : Interrupt_Set := (others => False);
- -- Reserve (I) is true iff the interrupt I is one that cannot be
- -- permitted to be attached to a user handler. The possible reasons
- -- are many. For example, it may be mapped to an exception used to
- -- implement task abortion, or used to implement time delays.
+ -- Reserve (I) is true iff the interrupt I is one that cannot be permitted
+ -- to be attached to a user handler. The possible reasons are many. For
+ -- example, it may be mapped to an exception used to implement task abort,
+ -- or used to implement time delays.
procedure Initialize_Interrupts;
-- On systems where there is no signal inheritance between tasks (e.g
-- VxWorks, GNU/LinuxThreads), this procedure is used to initialize
- -- interrupts handling in each task. Otherwise this function should
- -- only be called by initialize in this package body.
+ -- interrupts handling in each task. Otherwise this function should only
+ -- be called by initialize in this package body.
private
type Interrupt_Mask is new System.OS_Interface.sigset_t;
- -- In some implementation Interrupt_Mask can be represented
- -- as a linked list.
+ -- In some implementation Interrupt_Mask can be represented as a linked
+ -- list.
end System.Interrupt_Management;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This package encapsulates and centralizes information about all
--- uses of interrupts (or signals), including the target-dependent
--- mapping of interrupts (or signals) to exceptions.
+-- This package encapsulates and centralizes information about all uses of
+-- interrupts (or signals), including the target-dependent mapping of
+-- interrupts (or signals) to exceptions.
--- Unlike the original design, System.Interrupt_Management can only
--- be used for tasking systems.
+-- Unlike the original design, System.Interrupt_Management can only be used
+-- for tasking systems.
-- PLEASE DO NOT remove the Elaborate_Body pragma from this package.
-- Elaboration of this package should happen early, as most other
--- initializations depend on it. Forcing immediate elaboration of
--- the body also helps to enforce the design assumption that this
--- is a second-level package, just one level above System.OS_Interface
--- with no cross-dependencies.
-
--- PLEASE DO NOT put any subprogram declarations with arguments of
--- type Interrupt_ID into the visible part of this package. The type
--- Interrupt_ID is used to derive the type in Ada.Interrupts, and
--- adding more operations to that type would be illegal according
--- to the Ada Reference Manual. This is the reason why the signals
--- sets are implemeneted using visible arrays rather than functions.
+-- initializations depend on it. Forcing immediate elaboration of the body
+-- also helps to enforce the design assumption that this is a second-level
+-- package, just one level above System.OS_Interface with no
+-- cross-dependencies.
+
+-- PLEASE DO NOT put any subprogram declarations with arguments of type
+-- Interrupt_ID into the visible part of this package. The type Interrupt_ID
+-- is used to derive the type in Ada.Interrupts, and adding more operations
+-- to that type would be illegal according to the Ada Reference Manual. This
+-- is the reason why the signals sets are implemeneted using visible arrays
+-- rather than functions.
with System.OS_Interface;
-- used for sigset_t
type Interrupt_Set is array (Interrupt_ID) of Boolean;
- -- The following objects serve as constants, but are initialized
- -- in the body to aid portability. This permits us to use more
- -- portable names for interrupts, where distinct names may map to
- -- the same interrupt ID value.
- --
- -- For example, suppose SIGRARE is a signal that is not defined on
- -- all systems, but is always reserved when it is defined. If we
- -- have the convention that ID zero is not used for any "real"
- -- signals, and SIGRARE = 0 when SIGRARE is not one of the locally
- -- supported signals, we can write
- -- Reserved (SIGRARE) := true;
+ -- The following objects serve as constants, but are initialized in the
+ -- body to aid portability. This permits us to use more portable names for
+ -- interrupts, where distinct names may map to the same interrupt ID
+ -- value.
+
+ -- For example, suppose SIGRARE is a signal that is not defined on all
+ -- systems, but is always reserved when it is defined. If we have the
+ -- convention that ID zero is not used for any "real" signals, and SIGRARE
+ -- = 0 when SIGRARE is not one of the locally supported signals, we can
+ -- write
+
+ -- Reserved (SIGRARE) := True;
+
-- and the initialization code will be portable.
Abort_Task_Interrupt : Interrupt_ID;
- -- The interrupt that is used to implement task abortion if
- -- an interrupt is used for that purpose. This is one of the
- -- reserved interrupts.
+ -- The interrupt that is used to implement task abort if an interrupt is
+ -- used for that purpose. This is one of the reserved interrupts.
Keep_Unmasked : Interrupt_Set := (others => False);
- -- Keep_Unmasked (I) is true iff the interrupt I is one that must
- -- that must be kept unmasked at all times, except (perhaps) for
- -- short critical sections. This includes interrupts that are
- -- mapped to exceptions (see System.Interrupt_Exceptions.Is_Exception),
- -- but may also include interrupts (e.g. timer) that need to be kept
- -- unmasked for other reasons. Where interrupts are implemented as
- -- OS signals, and signal masking is per-task, the interrupt should
- -- be unmasked in ALL TASKS.
+ -- Keep_Unmasked (I) is true iff the interrupt I is one that must that
+ -- must be kept unmasked at all times, except (perhaps) for short critical
+ -- sections. This includes interrupts that are mapped to exceptions (see
+ -- System.Interrupt_Exceptions.Is_Exception), but may also include
+ -- interrupts (e.g. timer) that need to be kept unmasked for other
+ -- reasons. Where interrupts are implemented as OS signals, and signal
+ -- masking is per-task, the interrupt should be unmasked in ALL TASKS.
Reserve : Interrupt_Set := (others => False);
- -- Reserve (I) is true iff the interrupt I is one that cannot be
- -- permitted to be attached to a user handler. The possible reasons
- -- are many. For example, it may be mapped to an exception used to
- -- implement task abortion, or used to implement time delays.
+ -- Reserve (I) is true iff the interrupt I is one that cannot be permitted
+ -- to be attached to a user handler. The possible reasons are many. For
+ -- example, it may be mapped to an exception used to implement task abort,
+ -- or used to implement time delays.
procedure Initialize_Interrupts;
-- On systems where there is no signal inheritance between tasks (e.g
-- VxWorks, GNU/LinuxThreads), this procedure is used to initialize
- -- interrupts handling in each task. Otherwise this function should
- -- only be called by initialize in this package body.
+ -- interrupts handling in each task. Otherwise this function should only
+ -- be called by initialize in this package body.
private
type Interrupt_Mask is new System.OS_Interface.sigset_t;
- -- In some implementation Interrupt_Mask can be represented
- -- as a linked list.
+ -- In some implementations Interrupt_Mask can be represented as a linked
+ -- list.
end System.Interrupt_Management;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2005 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- --
-- This implementation assumes that the underlying malloc/free/realloc
-- implementation is thread safe, and thus, no additional lock is required.
--- Note that we still need to defer abortion because on most systems,
--- an asynchronous signal (as used for implementing asynchronous abortion
--- of task) cannot safely be handled while malloc is executing.
+-- Note that we still need to defer abort because on most systems, an
+-- asynchronous signal (as used for implementing asynchronous abort of
+-- task) cannot safely be handled while malloc is executing.
--- If you are not using Ada constructs containing the "abort" keyword,
--- then you can remove the calls to Abort_Defer.all and Abort_Undefer.all
--- from this unit.
+-- If you are not using Ada constructs containing the "abort" keyword, then
+-- you can remove the calls to Abort_Defer.all and Abort_Undefer.all from
+-- this unit.
with Ada.Exceptions;
with System.Soft_Links;
pragma Import
(Ada, Current_Target_Exception,
"__gnat_current_target_exception");
- -- Import this subprogram from the private part of Ada.Exceptions.
+ -- Import this subprogram from the private part of Ada.Exceptions
-- First we have the access subprogram types used to establish the links.
-- The approach is to establish variables containing access subprogram
-- Declarations for the no tasking versions of the required routines
procedure Abort_Defer_NT;
- -- Defer task abortion (non-tasking case, does nothing)
+ -- Defer task abort (non-tasking case, does nothing)
procedure Abort_Undefer_NT;
- -- Undefer task abortion (non-tasking case, does nothing)
+ -- Undefer task abort (non-tasking case, does nothing)
procedure Abort_Handler_NT;
- -- Handle task abortion (non-tasking case, does nothing). Currently,
- -- only VMS uses this.
+ -- Handle task abort (non-tasking case, does nothing). Currently, only VMS
+ -- uses this.
procedure Update_Exception_NT (X : EO := Current_Target_Exception);
- -- Handle exception setting. This routine is provided for targets
- -- which have built-in exception handling such as the Java Virtual
- -- Machine. Currently, only JGNAT uses this. See 4jexcept.ads for
- -- an explanation on how this routine is used.
+ -- Handle exception setting. This routine is provided for targets which
+ -- have built-in exception handling such as the Java Virtual Machine.
+ -- Currently, only JGNAT uses this. See 4jexcept.ads for an explanation on
+ -- how this routine is used.
function Check_Abort_Status_NT return Integer;
-- Returns Boolean'Pos (True) iff abort signal should raise
Abort_Defer : No_Param_Proc := Abort_Defer_NT'Access;
pragma Suppress (Access_Check, Abort_Defer);
- -- Defer task abortion (task/non-task case as appropriate)
+ -- Defer task abort (task/non-task case as appropriate)
Abort_Undefer : No_Param_Proc := Abort_Undefer_NT'Access;
pragma Suppress (Access_Check, Abort_Undefer);
- -- Undefer task abortion (task/non-task case as appropriate)
+ -- Undefer task abort (task/non-task case as appropriate)
Abort_Handler : No_Param_Proc := Abort_Handler_NT'Access;
- -- Handle task abortion (task/non-task case as appropriate)
+ -- Handle task abort (task/non-task case as appropriate)
Update_Exception : Special_EO_Call := Update_Exception_NT'Access;
-- Handle exception setting and tasking polling when appropriate
-- explicitly or implicitly during the critical locked region.
Adafinal : No_Param_Proc := Null_Adafinal'Access;
- -- Performs the finalization of the Ada Runtime.
+ -- Performs the finalization of the Ada Runtime
function Get_Jmpbuf_Address_NT return Address;
procedure Set_Jmpbuf_Address_NT (Addr : Address);
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This package contains the procedures to implements timeouts (delays)
--- for asynchronous select statements.
+-- This package contains the procedures to implements timeouts (delays) for
+-- asynchronous select statements.
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes.
(T : in Duration;
D : Delay_Block_Access) return Boolean;
-- Enqueue the specified relative delay. Returns True if the delay has
- -- been enqueued, False if it has already expired.
- -- If the delay has been enqueued, abortion is deferred.
+ -- been enqueued, False if it has already expired. If the delay has been
+ -- enqueued, abort is deferred.
procedure Cancel_Async_Delay (D : Delay_Block_Access);
-- Cancel the specified asynchronous delay
private
type Delay_Block is record
- Self_Id : Task_Id;
+ Self_Id : Task_Id;
-- ID of the calling task
- Level : ATC_Level_Base;
+ Level : ATC_Level_Base;
-- Normally Level is the ATC nesting level of the
-- async. select statement to which this delay belongs, but
-- after a call has been dequeued we set it to
Resume_Time : Duration;
-- The absolute wake up time, represented as Duration
- Timed_Out : Boolean := False;
+ Timed_Out : Boolean := False;
-- Set to true if the delay has timed out
- Succ, Pred : Delay_Block_Access;
+ Succ, Pred : Delay_Block_Access;
-- A double linked list
end record;
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2004, Ada Core Technologies --
+-- Copyright (C) 1995-2005, Ada Core Technologies --
-- --
-- GNARL 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- --
Ceiling_Violation : Boolean;
begin
- -- The lock is made without defering abortion.
+ -- The lock is made without defering abort
- -- Therefore the abortion has to be deferred before calling this
- -- routine. This means that the compiler has to generate a Defer_Abort
- -- call before the call to Lock.
+ -- Therefore the abort has to be deferred before calling this routine.
+ -- This means that the compiler has to generate a Defer_Abort call
+ -- before the call to Lock.
- -- The caller is responsible for undeferring abortion, and compiler
+ -- The caller is responsible for undeferring abort, and compiler
-- generated calls must be protected with cleanup handlers to ensure
- -- that abortion is undeferred in all cases.
+ -- that abort is undeferred in all cases.
Write_Lock (Object.L'Access, Ceiling_Violation);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- Local Data --
-----------------
- -- The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr.
+ -- The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr
-- This API reserves a small range of virtual addresses that is backed
-- by different physical memory for each running thread. In this case we
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
Environment_Task_Id : Task_Id;
- -- A variable to hold Task_Id for the environment task.
+ -- A variable to hold Task_Id for the environment task
-----------------------
-- Local Subprograms --
Self_ID : Task_Id renames Thread_Local_Data_Ptr.Self_ID;
begin
- -- Check that the thread local data has been initialized.
+ -- Check that the thread local data has been initialized
pragma Assert
((Thread_Local_Data_Ptr /= null
Count : aliased ULONG; -- Used to store dummy result
begin
- -- Must reset Cond BEFORE L is unlocked.
+ -- Must reset Cond BEFORE L is unlocked
Sem_Must_Not_Fail
(DosResetEventSem (Self_ID.Common.LL.CV, Count'Unchecked_Access));
Sem_Must_Not_Fail
(DosWaitEventSem (Self_ID.Common.LL.CV, SEM_INDEFINITE_WAIT));
- -- Since L was previously accquired, lock operation should not fail.
+ -- Since L was previously accquired, lock operation should not fail
if Single_Lock then
Lock_RTS;
Count : aliased ULONG; -- Used to store dummy result
begin
- -- Must reset Cond BEFORE Self_ID is unlocked.
+ -- Must reset Cond BEFORE Self_ID is unlocked
Sem_Must_Not_Fail
(DosResetEventSem (Self_ID.Common.LL.CV,
Write_Lock (Self_ID);
end if;
- -- Must reset Cond BEFORE Self_ID is unlocked.
+ -- Must reset Cond BEFORE Self_ID is unlocked
Sem_Must_Not_Fail
(DosResetEventSem (Self_ID.Common.LL.CV,
procedure Enter_Task (Self_ID : Task_Id) is
begin
- -- Initialize thread local data. Must be done first.
+ -- Initialize thread local data. Must be done first
Thread_Local_Data_Ptr.Self_ID := Self_ID;
Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
T.Common.LL.Wrapper := To_PFNTHREAD (Wrapper);
- -- The OS implicitly gives the new task the priority of this task.
+ -- The OS implicitly gives the new task the priority of this task
T.Common.LL.Current_Priority := Self.Common.LL.Current_Priority;
begin
null;
- -- Task abortion not implemented yet.
+ -- Task abort not implemented yet.
-- Should perform other action ???
end Abort_Task;
Environment_Task_Id := Environment_Task;
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
- -- Initialize the lock used to synchronize chain of all ATCBs.
+ -- Initialize the lock used to synchronize chain of all ATCBs
- -- Set ID of environment task.
+ -- Set ID of environment task
Thread_Local_Data_Ptr.Self_ID := Environment_Task;
Environment_Task.Common.LL.Thread := 1; -- By definition
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- Local Data --
----------------
- -- The followings are logically constants, but need to be initialized
- -- at run time.
+ -- The followings are logically constants, but need to be initialized at
+ -- run time.
Single_RTS_Lock : aliased RTS_Lock;
- -- This is a lock to allow only one thread of control in the RTS at
- -- a time; it is used to execute in mutual exclusion from all other tasks.
+ -- This is a lock to allow only one thread of control in the RTS at a
+ -- time; it is used to execute in mutual exclusion from all other tasks.
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
ATCB_Key : aliased System.Address := System.Null_Address;
-- targets.
Environment_Task_Id : Task_Id;
- -- A variable to hold Task_Id for the environment task.
+ -- A variable to hold Task_Id for the environment task
Unblocked_Signal_Mask : aliased sigset_t;
-- The set of signals that should unblocked in all tasks
- -- The followings are internal configuration constants needed.
+ -- The followings are internal configuration constants needed
Time_Slice_Val : Integer;
pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
- -- Indicates whether FIFO_Within_Priorities is set.
+ -- Indicates whether FIFO_Within_Priorities is set
Mutex_Protocol : Priority_Type;
Foreign_Task_Elaborated : aliased Boolean := True;
- -- Used to identified fake tasks (i.e., non-Ada Threads).
+ -- Used to identified fake tasks (i.e., non-Ada Threads)
--------------------
-- Local Packages --
procedure Set (Self_Id : Task_Id);
pragma Inline (Set);
- -- Set the self id for the current task.
+ -- Set the self id for the current task
function Self return Task_Id;
pragma Inline (Self);
- -- Return a pointer to the Ada Task Control Block of the calling task.
+ -- Return a pointer to the Ada Task Control Block of the calling task
end Specific;
package body Specific is separate;
- -- The body of this package is target specific.
+ -- The body of this package is target specific
---------------------------------
-- Support for foreign threads --
---------------------------------
function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
- -- Allocate and Initialize a new ATCB for the current Thread.
+ -- Allocate and Initialize a new ATCB for the current Thread
function Register_Foreign_Thread
(Thread : Thread_Id) return Task_Id is separate;
-----------------------
procedure Abort_Handler (signo : Signal);
- -- Handler for the abort (SIGABRT) signal to handle asynchronous abortion.
+ -- Handler for the abort (SIGABRT) signal to handle asynchronous abort
procedure Install_Signal_Handlers;
-- Install the default signal handlers for the current task
begin
pragma Assert (Self_ID = Self);
- -- Release the mutex before sleeping.
+ -- Release the mutex before sleeping
+
if Single_Lock then
Result := semGive (Single_RTS_Lock.Mutex);
else
pragma Assert (Result = 0);
- -- Perform a blocking operation to take the CV semaphore.
- -- Note that a blocking operation in VxWorks will reenable
- -- task scheduling. When we are no longer blocked and control
- -- is returned, task scheduling will again be disabled.
+ -- Perform a blocking operation to take the CV semaphore. Note that a
+ -- blocking operation in VxWorks will reenable task scheduling. When we
+ -- are no longer blocked and control is returned, task scheduling will
+ -- again be disabled.
Result := semTake (Self_ID.Common.LL.CV, WAIT_FOREVER);
pragma Assert (Result = 0);
- -- Take the mutex back.
+ -- Take the mutex back
+
if Single_Lock then
Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
else
-- Timed_Sleep --
-----------------
- -- This is for use within the run-time system, so abort is
- -- assumed to be already deferred, and the caller should be
- -- holding its own ATCB lock.
+ -- This is for use within the run-time system, so abort is assumed to be
+ -- already deferred, and the caller should be holding its own ATCB lock.
procedure Timed_Sleep
(Self_ID : Task_Id;
if Mode = Relative then
Absolute := Orig + Time;
- -- Systematically add one since the first tick will delay
- -- *at most* 1 / Rate_Duration seconds, so we need to add one to
- -- be on the safe side.
+ -- Systematically add one since the first tick will delay *at most*
+ -- 1 / Rate_Duration seconds, so we need to add one to be on the
+ -- safe side.
Ticks := To_Clock_Ticks (Time);
if Ticks > 0 then
loop
- -- Release the mutex before sleeping.
+ -- Release the mutex before sleeping
+
if Single_Lock then
Result := semGive (Single_RTS_Lock.Mutex);
else
pragma Assert (Result = 0);
- -- Perform a blocking operation to take the CV semaphore.
- -- Note that a blocking operation in VxWorks will reenable
- -- task scheduling. When we are no longer blocked and control
- -- is returned, task scheduling will again be disabled.
+ -- Perform a blocking operation to take the CV semaphore. Note
+ -- that a blocking operation in VxWorks will reenable task
+ -- scheduling. When we are no longer blocked and control is
+ -- returned, task scheduling will again be disabled.
Result := semTake (Self_ID.Common.LL.CV, Ticks);
if Result = 0 then
+
-- Somebody may have called Wakeup for us
Wakeup := True;
else
if errno /= S_objLib_OBJ_TIMEOUT then
Wakeup := True;
+
else
- -- If Ticks = int'last, it was most probably truncated
- -- so let's make another round after recomputing Ticks
- -- from the the absolute time.
+ -- If Ticks = int'last, it was most probably truncated so
+ -- let's make another round after recomputing Ticks from
+ -- the the absolute time.
if Ticks /= int'Last then
Timedout := True;
end if;
end if;
- -- Take the mutex back.
+ -- Take the mutex back
+
if Single_Lock then
Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
else
else
Timedout := True;
- -- Should never hold a lock while yielding.
+ -- Should never hold a lock while yielding
+
if Single_Lock then
Result := semGive (Single_RTS_Lock.Mutex);
taskDelay (0);
-- Timed_Delay --
-----------------
- -- This is for use in implementing delay statements, so
- -- we assume the caller is holding no locks.
+ -- This is for use in implementing delay statements, so we assume the
+ -- caller is holding no locks.
procedure Timed_Delay
(Self_ID : Task_Id;
if Ticks > 0 and then Ticks < int'Last then
- -- The first tick will delay anytime between 0 and
- -- 1 / sysClkRateGet seconds, so we need to add one to
- -- be on the safe side.
+ -- First tick will delay anytime between 0 and 1 / sysClkRateGet
+ -- seconds, so we need to add one to be on the safe side.
Ticks := Ticks + 1;
end if;
end if;
if Ticks > 0 then
- -- Modifying State and Pending_Priority_Change, locking the TCB.
+
+ -- Modifying State and Pending_Priority_Change, locking the TCB
+
if Single_Lock then
Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
else
Result := semTake (Self_ID.Common.LL.CV, Ticks);
if Result /= 0 then
+
-- If Ticks = int'last, it was most probably truncated
-- so let's make another round after recomputing Ticks
-- from the the absolute time.
if FIFO_Within_Priorities then
-- Annex D requirement [RM D.2.2 par. 9]:
+
-- If the task drops its priority due to the loss of inherited
-- priority, it is added at the head of the ready queue for its
-- new active priority.
procedure Enter_Task (Self_ID : Task_Id) is
procedure Init_Float;
pragma Import (C, Init_Float, "__gnat_init_float");
- -- Properly initializes the FPU for PPC/MIPS systems.
+ -- Properly initializes the FPU for PPC/MIPS systems
begin
Self_ID.Common.LL.Thread := taskIdSelf;
Init_Float;
- -- Install the signal handlers.
+ -- Install the signal handlers
+
-- This is called for each task since there is no signal inheritance
-- between VxWorks tasks.
Adjusted_Stack_Size := size_t (Stack_Size);
end if;
- -- Ask for 4 extra bytes of stack space so that the ATCB
- -- pointer can be stored below the stack limit, plus extra
- -- space for the frame of Task_Wrapper. This is so the user
- -- gets the amount of stack requested exclusive of the needs
- -- of the runtime.
+ -- Ask for four extra bytes of stack space so that the ATCB pointer can
+ -- be stored below the stack limit, plus extra space for the frame of
+ -- Task_Wrapper. This is so the user gets the amount of stack requested
+ -- exclusive of the needs
--
- -- We also have to allocate n more bytes for the task name
- -- storage and enough space for the Wind Task Control Block
- -- which is around 0x778 bytes. VxWorks also seems to carve out
- -- additional space, so use 2048 as a nice round number.
- -- We might want to increment to the nearest page size in
- -- case we ever support VxVMI.
+ -- We also have to allocate n more bytes for the task name storage and
+ -- enough space for the Wind Task Control Block which is around 0x778
+ -- bytes. VxWorks also seems to carve out additional space, so use 2048
+ -- as a nice round number. We might want to increment to the nearest
+ -- page size in case we ever support VxVMI.
--
- -- XXX - we should come back and visit this so we can
- -- set the task name to something appropriate.
+ -- XXX - we should come back and visit this so we can set the task name
+ -- to something appropriate.
Adjusted_Stack_Size := Adjusted_Stack_Size + 2048;
-- Since the initial signal mask of a thread is inherited from the
- -- creator, and the Environment task has all its signals masked, we
- -- do not need to manipulate caller's signal mask at this point.
- -- All tasks in RTS will have All_Tasks_Mask initially.
+ -- creator, and the Environment task has all its signals masked, we do
+ -- not need to manipulate caller's signal mask at this point. All tasks
+ -- in RTS will have All_Tasks_Mask initially.
if T.Common.Task_Image_Len = 0 then
T.Common.LL.Thread := taskSpawn
else
declare
Name : aliased String (1 .. T.Common.Task_Image_Len + 1);
+
begin
Name (1 .. Name'Last - 1) :=
T.Common.Task_Image (1 .. T.Common.Task_Image_Len);
begin
Result := kill (T.Common.LL.Thread,
- Signal (Interrupt_Management.Abort_Task_Signal));
+ Signal (Interrupt_Management.Abort_Task_Signal));
pragma Assert (Result = 0);
end Abort_Task;
Environment_Task_Id := Environment_Task;
- -- Initialize the lock used to synchronize chain of all ATCBs.
+ -- Initialize the lock used to synchronize chain of all ATCBs
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
procedure Enter_Task (Self_ID : ST.Task_Id);
pragma Inline (Enter_Task);
- -- Initialize data structures specific to the calling task.
- -- Self must be the ID of the calling task.
- -- It must be called (once) by the task immediately after creation,
- -- while abortion is still deferred.
- -- The effects of other operations defined below are not defined
- -- unless the caller has previously called Initialize_Task.
+ -- Initialize data structures specific to the calling task. Self must be
+ -- the ID of the calling task. It must be called (once) by the task
+ -- immediately after creation, while abort is still deferred. The effects
+ -- of other operations defined below are not defined unless the caller has
+ -- previously called Initialize_Task.
procedure Exit_Task;
pragma Inline (Exit_Task);
- -- Destroy the thread of control.
- -- Self must be the ID of the calling task.
- -- The effects of further calls to operations defined below
- -- on the task are undefined thereafter.
+ -- Destroy the thread of control. Self must be the ID of the calling task.
+ -- The effects of further calls to operations defined below on the task
+ -- are undefined thereafter.
function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id;
pragma Inline (New_ATCB);
- -- Allocate a new ATCB with the specified number of entries.
+ -- Allocate a new ATCB with the specified number of entries
procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean);
pragma Inline (Initialize_TCB);
procedure Finalize_TCB (T : ST.Task_Id);
pragma Inline (Finalize_TCB);
- -- Finalizes Private_Data of ATCB, and then deallocates it.
- -- This is also responsible for recovering any storage or other resources
- -- that were allocated by Create_Task (the one in this package).
- -- This should only be called from Free_Task.
- -- After it is called there should be no further
+ -- Finalizes Private_Data of ATCB, and then deallocates it. This is also
+ -- responsible for recovering any storage or other resources that were
+ -- allocated by Create_Task (the one in this package). This should only be
+ -- called from Free_Task. After it is called there should be no further
-- reference to the ATCB that corresponds to T.
procedure Abort_Task (T : ST.Task_Id);
pragma Inline (Abort_Task);
- -- Abort the task specified by T (the target task). This causes
- -- the target task to asynchronously raise Abort_Signal if
- -- abort is not deferred, or if it is blocked on an interruptible
- -- system call.
+ -- Abort the task specified by T (the target task). This causes the target
+ -- task to asynchronously raise Abort_Signal if abort is not deferred, or
+ -- if it is blocked on an interruptible system call.
--
-- precondition:
-- the calling task is holding T's lock and has abort deferred
function Self return ST.Task_Id;
pragma Inline (Self);
- -- Return a pointer to the Ada Task Control Block of the calling task.
+ -- Return a pointer to the Ada Task Control Block of the calling task
type Lock_Level is
(PO_Level,
RTS_Lock_Level,
ATCB_Level);
-- Type used to describe kind of lock for second form of Initialize_Lock
- -- call specified below.
- -- See locking rules in System.Tasking (spec) for more details.
+ -- call specified below. See locking rules in System.Tasking (spec) for
+ -- more details.
procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock);
procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level);
pragma Inline (Initialize_Lock);
-- Initialize a lock object.
--
- -- For Lock, Prio is the ceiling priority associated with the lock.
- -- For RTS_Lock, the ceiling is implicitly Priority'Last.
+ -- For Lock, Prio is the ceiling priority associated with the lock. For
+ -- RTS_Lock, the ceiling is implicitly Priority'Last.
--
-- If the underlying system does not support priority ceiling
-- locking, the Prio parameter is ignored.
--
- -- The effect of either initialize operation is undefined unless L
- -- is a lock object that has not been initialized, or which has been
- -- finalized since it was last initialized.
+ -- The effect of either initialize operation is undefined unless is a lock
+ -- object that has not been initialized, or which has been finalized since
+ -- it was last initialized.
--
- -- The effects of the other operations on lock objects
- -- are undefined unless the lock object has been initialized
- -- and has not since been finalized.
+ -- The effects of the other operations on lock objects are undefined
+ -- unless the lock object has been initialized and has not since been
+ -- finalized.
--
-- Initialization of the per-task lock is implicit in Create_Task.
--
-- read or write permission. (That is, matching pairs of Lock and Unlock
-- operations on each lock object must be properly nested.)
- -- For the operation on RTS_Lock, Global_Lock should be set to True
- -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock).
+ -- For the operation on RTS_Lock, Global_Lock should be set to True if L
+ -- is a global lock (Single_RTS_Lock, Global_Task_Lock).
--
-- Note that Write_Lock for RTS_Lock does not have an out-parameter.
- -- RTS_Locks are used in situations where we have not made provision
- -- for recovery from ceiling violations. We do not expect them to
- -- occur inside the runtime system, because all RTS locks have ceiling
- -- Priority'Last.
-
- -- There is one way there can be a ceiling violation.
- -- That is if the runtime system is called from a task that is
- -- executing in the Interrupt_Priority range.
-
- -- It is not clear what to do about ceiling violations due
- -- to RTS calls done at interrupt priority. In general, it
- -- is not acceptable to give all RTS locks interrupt priority,
- -- since that whould give terrible performance on systems where
- -- this has the effect of masking hardware interrupts, though we
- -- could get away with allowing Interrupt_Priority'last where we
- -- are layered on an OS that does not allow us to mask interrupts.
- -- Ideally, we would like to raise Program_Error back at the
- -- original point of the RTS call, but this would require a lot of
- -- detailed analysis and recoding, with almost certain performance
- -- penalties.
-
- -- For POSIX systems, we considered just skipping setting a
- -- priority ceiling on RTS locks. This would mean there is no
- -- ceiling violation, but we would end up with priority inversions
- -- inside the runtime system, resulting in failure to satisfy the
- -- Ada priority rules, and possible missed validation tests.
- -- This could be compensated-for by explicit priority-change calls
- -- to raise the caller to Priority'Last whenever it first enters
- -- the runtime system, but the expected overhead seems high, though
- -- it might be lower than using locks with ceilings if the underlying
- -- implementation of ceiling locks is an inefficient one.
-
- -- This issue should be reconsidered whenever we get around to
- -- checking for calls to potentially blocking operations from
- -- within protected operations. If we check for such calls and
- -- catch them on entry to the OS, it may be that we can eliminate
- -- the possibility of ceiling violations inside the RTS. For this
- -- to work, we would have to forbid explicitly setting the priority
- -- of a task to anything in the Interrupt_Priority range, at least.
- -- We would also have to check that there are no RTS-lock operations
- -- done inside any operations that are not treated as potentially
- -- blocking.
-
- -- The latter approach seems to be the best, i.e. to check on entry
- -- to RTS calls that may need to use locks that the priority is not
- -- in the interrupt range. If there are RTS operations that NEED to
- -- be called from interrupt handlers, those few RTS locks should then
- -- be converted to PO-type locks, with ceiling Interrupt_Priority'Last.
-
- -- For now, we will just shut down the system if there is a
- -- ceiling violation.
+ -- RTS_Locks are used in situations where we have not made provision for
+ -- recovery from ceiling violations. We do not expect them to occur inside
+ -- the runtime system, because all RTS locks have ceiling Priority'Last.
+
+ -- There is one way there can be a ceiling violation. That is if the
+ -- runtime system is called from a task that is executing in the
+ -- Interrupt_Priority range.
+
+ -- It is not clear what to do about ceiling violations due to RTS calls
+ -- done at interrupt priority. In general, it is not acceptable to give
+ -- all RTS locks interrupt priority, since that whould give terrible
+ -- performance on systems where this has the effect of masking hardware
+ -- interrupts, though we could get away with allowing
+ -- Interrupt_Priority'last where we are layered on an OS that does not
+ -- allow us to mask interrupts. Ideally, we would like to raise
+ -- Program_Error back at the original point of the RTS call, but this
+ -- would require a lot of detailed analysis and recoding, with almost
+ -- certain performance penalties.
+
+ -- For POSIX systems, we considered just skipping setting priority ceiling
+ -- on RTS locks. This would mean there is no ceiling violation, but we
+ -- would end up with priority inversions inside the runtime system,
+ -- resulting in failure to satisfy the Ada priority rules, and possible
+ -- missed validation tests. This could be compensated-for by explicit
+ -- priority-change calls to raise the caller to Priority'Last whenever it
+ -- first enters the runtime system, but the expected overhead seems high,
+ -- though it might be lower than using locks with ceilings if the
+ -- underlying implementation of ceiling locks is an inefficient one.
+
+ -- This issue should be reconsidered whenever we get around to checking
+ -- for calls to potentially blocking operations from within protected
+ -- operations. If we check for such calls and catch them on entry to the
+ -- OS, it may be that we can eliminate the possibility of ceiling
+ -- violations inside the RTS. For this to work, we would have to forbid
+ -- explicitly setting the priority of a task to anything in the
+ -- Interrupt_Priority range, at least. We would also have to check that
+ -- there are no RTS-lock operations done inside any operations that are
+ -- not treated as potentially blocking.
+
+ -- The latter approach seems to be the best, i.e. to check on entry to RTS
+ -- calls that may need to use locks that the priority is not in the
+ -- interrupt range. If there are RTS operations that NEED to be called
+ -- from interrupt handlers, those few RTS locks should then be converted
+ -- to PO-type locks, with ceiling Interrupt_Priority'Last.
+
+ -- For now, we will just shut down the system if there is ceiling violation
procedure Yield (Do_Yield : Boolean := True);
pragma Inline (Yield);
- -- Yield the processor. Add the calling task to the tail of the
- -- ready queue for its active_priority.
- -- The Do_Yield argument is only used in some very rare cases very
- -- a yield should have an effect on a specific target and not on regular
- -- ones.
+ -- Yield the processor. Add the calling task to the tail of the ready
+ -- queue for its active_priority. The Do_Yield argument is only used in
+ -- some very rare cases very a yield should have an effect on a specific
+ -- target and not on regular ones.
procedure Set_Priority
(T : ST.Task_Id;
Prio : System.Any_Priority;
Loss_Of_Inheritance : Boolean := False);
pragma Inline (Set_Priority);
- -- Set the priority of the task specified by T to T.Current_Priority.
- -- The priority set is what would correspond to the Ada concept of
- -- "base priority" in the terms of the lower layer system, but
- -- the operation may be used by the upper layer to implement
- -- changes in "active priority" that are not due to lock effects.
- -- The effect should be consistent with the Ada Reference Manual.
- -- In particular, when a task lowers its priority due to the loss of
- -- inherited priority, it goes at the head of the queue for its new
- -- priority (RM D.2.2 par 9). Loss_Of_Inheritance helps the underlying
- -- implementation to do it right when the OS doesn't.
+ -- Set the priority of the task specified by T to T.Current_Priority. The
+ -- priority set is what would correspond to the Ada concept of "base
+ -- priority" in the terms of the lower layer system, but the operation may
+ -- be used by the upper layer to implement changes in "active priority"
+ -- that are not due to lock effects. The effect should be consistent with
+ -- the Ada Reference Manual. In particular, when a task lowers its
+ -- priority due to the loss of inherited priority, it goes at the head of
+ -- the queue for its new priority (RM D.2.2 par 9). Loss_Of_Inheritance
+ -- helps the underlying implementation to do it right when the OS doesn't.
function Get_Priority (T : ST.Task_Id) return System.Any_Priority;
pragma Inline (Get_Priority);
- -- Returns the priority last set by Set_Priority for this task.
+ -- Returns the priority last set by Set_Priority for this task
function Monotonic_Clock return Duration;
pragma Inline (Monotonic_Clock);
-- and has abort deferred
--
-- postcondition:
- -- The calling task is holding its own ATCB lock
- -- and has abort deferred.
+ -- The calling task is holding its own ATCB lock and has abort deferred.
-- The effect is to atomically unlock T's lock and wait, so that another
-- task that is able to lock T's lock can be assured that the wait has
-- actually commenced, and that a Wakeup operation will cause the waiting
- -- task to become ready for execution once again. When Sleep returns,
- -- the waiting task will again hold its own ATCB lock. The waiting task
- -- may become ready for execution at any time (that is, spurious wakeups
- -- are permitted), but it will definitely become ready for execution when
- -- a Wakeup operation is performed for the same task.
+ -- task to become ready for execution once again. When Sleep returns, the
+ -- waiting task will again hold its own ATCB lock. The waiting task may
+ -- become ready for execution at any time (that is, spurious wakeups are
+ -- permitted), but it will definitely become ready for execution when a
+ -- Wakeup operation is performed for the same task.
procedure Timed_Sleep
(Self_ID : ST.Task_Id;
-- RTS Entrance/Exit --
-----------------------
- -- Following two routines are used for possible operations needed
- -- to be setup/cleared upon entrance/exit of RTS while maintaining
- -- a single thread of control in the RTS. Since we intend these
- -- routines to be used for implementing the Single_Lock RTS,
- -- Lock_RTS should follow the first Defer_Abortion operation
- -- entering RTS. In the same fashion Unlock_RTS should preceed
- -- the last Undefer_Abortion exiting RTS.
+ -- Following two routines are used for possible operations needed to be
+ -- setup/cleared upon entrance/exit of RTS while maintaining a single
+ -- thread of control in the RTS. Since we intend these routines to be used
+ -- for implementing the Single_Lock RTS, Lock_RTS should follow the first
+ -- Defer_Abortion operation entering RTS. In the same fashion Unlock_RTS
+ -- should preceed the last Undefer_Abortion exiting RTS.
--
-- These routines also replace the functions Lock/Unlock_All_Tasks_List
procedure Lock_RTS;
- -- Take the global RTS lock.
+ -- Take the global RTS lock
procedure Unlock_RTS;
- -- Release the global RTS lock.
+ -- Release the global RTS lock
--------------------
-- Stack Checking --
-- an insufficient amount of stack space remains in the current task.
-- The exact mechanism for a stack probe is target dependent. Typical
- -- possibilities are to use a load from a non-existent page, a store
- -- to a read-only page, or a comparison with some stack limit constant.
- -- Where possible we prefer to use a trap on a bad page access, since
- -- this has less overhead. The generation of stack probes is either
- -- automatic if the ABI requires it (as on for example DEC Unix), or
- -- is controlled by the gcc parameter -fstack-check.
-
- -- When we are using bad-page accesses, we need a bad page, called a
- -- guard page, at the end of each task stack. On some systems, this
- -- is provided automatically, but on other systems, we need to create
- -- the guard page ourselves, and the procedure Stack_Guard is provided
- -- for this purpose.
+ -- possibilities are to use a load from a non-existent page, a store to a
+ -- read-only page, or a comparison with some stack limit constant. Where
+ -- possible we prefer to use a trap on a bad page access, since this has
+ -- less overhead. The generation of stack probes is either automatic if
+ -- the ABI requires it (as on for example DEC Unix), or is controlled by
+ -- the gcc parameter -fstack-check.
+
+ -- When we are using bad-page accesses, we need a bad page, called guard
+ -- page, at the end of each task stack. On some systems, this is provided
+ -- automatically, but on other systems, we need to create the guard page
+ -- ourselves, and the procedure Stack_Guard is provided for this purpose.
procedure Stack_Guard (T : ST.Task_Id; On : Boolean);
-- Ensure guard page is set if one is needed and the underlying thread
-- system does not provide it. The procedure is as follows:
--
-- 1. When we create a task adjust its size so a guard page can
- -- safely be set at the bottom of the stack
+ -- safely be set at the bottom of the stack.
--
-- 2. When the thread is created (and its stack allocated by the
-- underlying thread system), get the stack base (and size, depending
- -- how the stack is growing), and create the guard page taking care of
- -- page boundaries issues.
+ -- how the stack is growing), and create the guard page taking care
+ -- of page boundaries issues.
--
-- 3. When the task is destroyed, remove the guard page.
--
function Check_Exit (Self_ID : ST.Task_Id) return Boolean;
pragma Inline (Check_Exit);
- -- Check that the current task is holding only Global_Task_Lock.
+ -- Check that the current task is holding only Global_Task_Lock
function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean;
pragma Inline (Check_No_Locks);
- -- Check that current task is holding no locks.
+ -- Check that current task is holding no locks
function Suspend_Task
(T : ST.Task_Id;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- to poll it can cause infinite loops.
with Ada.Exceptions;
--- used for Exception_Occurrence_Access.
+-- Used for Exception_Occurrence_Access
with System.Tasking;
pragma Elaborate_All (System.Tasking);
--- ensure that the first step initializations have been performed
+-- Ensure that the first step initializations have been performed
with System.Task_Primitives;
--- used for Lock
+-- Used for Lock
with System.Task_Primitives.Operations;
--- used for Set_Priority
+-- Used for Set_Priority
-- Write_Lock
-- Unlock
-- Initialize_Lock
with System.Soft_Links;
--- used for the non-tasking routines (*_NT) that refer to global data.
+-- Used for the non-tasking routines (*_NT) that refer to global data.
-- They are needed here before the tasking run time has been elaborated.
with System.Soft_Links.Tasking;
-- Used for Init_Tasking_Soft_Links
with System.Tasking.Debug;
--- used for Trace
+-- Used for Trace
with System.Stack_Checking;
function Current_Target_Exception return AE.Exception_Occurrence;
pragma Import
(Ada, Current_Target_Exception, "__gnat_current_target_exception");
- -- Import this subprogram from the private part of Ada.Exceptions.
+ -- Import this subprogram from the private part of Ada.Exceptions
----------------------------------------------------------------------
-- Tasking versions of some services needed by non-tasking programs --
-- Change_Base_Priority --
--------------------------
- -- Call only with abort deferred and holding Self_ID locked.
+ -- Call only with abort deferred and holding Self_ID locked
procedure Change_Base_Priority (T : Task_Id) is
begin
-- while we had abort deferred below.
loop
- -- Temporarily defer abortion so that we can lock Self_ID.
+ -- Temporarily defer abort so that we can lock Self_ID
Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
Unlock_RTS;
end if;
- -- Restore the original Deferral value.
+ -- Restore the original Deferral value
Self_ID.Deferral_Level := Self_ID.Deferral_Level - 1;
SSL.Tasking.Init_Tasking_Soft_Links;
- -- Install tasking locks in the GCC runtime.
+ -- Install tasking locks in the GCC runtime
Gnat_Install_Locks (Task_Lock'Access, Task_Unlock'Access);
- -- Abortion is deferred in a new ATCB, so we need to undefer abortion
+ -- Abort is deferred in a new ATCB, so we need to undefer abort
-- at this stage to make the environment task abortable.
Undefer_Abort (Environment_Task);
-- hurt to uncomment the above call, until the error is corrected for
-- all targets.
- -- See extended comments in package body System.Tasking.Abortion
- -- for the overall design of the implementation of task abort.
+ -- See extended comments in package body System.Tasking.Abort for the
+ -- overall design of the implementation of task abort.
+ -- ??? there is no such package ???
- -- If the task is sleeping it will be in an abort-deferred region,
- -- and will not have Abort_Signal raised by Abort_Task.
- -- Such an "abort deferral" is just to protect the RTS internals,
- -- and not necessarily required to enforce Ada semantics.
- -- Abort_Task should wake the task up and let it decide if it wants
- -- to complete the aborted construct immediately.
+ -- If the task is sleeping it will be in an abort-deferred region, and
+ -- will not have Abort_Signal raised by Abort_Task. Such an "abort
+ -- deferral" is just to protect the RTS internals, and not necessarily
+ -- required to enforce Ada semantics. Abort_Task should wake the task up
+ -- and let it decide if it wants to complete the aborted construct
+ -- immediately.
-- Note that the effect of the lowl-level Abort_Task is not persistent.
-- If the target task is not blocked, this wakeup will be missed.
-- implement delays). That still left the possibility of missed
-- wakeups.
- -- We cannot safely call Vulnerable_Complete_Activation here,
- -- since that requires locking Self_ID.Parent. The anti-deadlock
- -- lock ordering rules would then require us to release the lock
- -- on Self_ID first, which would create a timing window for other
- -- tasks to lock Self_ID. This is significant for tasks that may be
- -- aborted before their execution can enter the task body, and so
- -- they do not get a chance to call Complete_Task. The actual work
- -- for this case is done in Terminate_Task.
+ -- We cannot safely call Vulnerable_Complete_Activation here, since that
+ -- requires locking Self_ID.Parent. The anti-deadlock lock ordering rules
+ -- would then require us to release the lock on Self_ID first, which would
+ -- create a timing window for other tasks to lock Self_ID. This is
+ -- significant for tasks that may be aborted before their execution can
+ -- enter the task body, and so they do not get a chance to call
+ -- Complete_Task. The actual work for this case is done in Terminate_Task.
procedure Locked_Abort_To_Level
(Self_ID : Task_Id;
-- Precondition : Self does not hold any locks!
- -- Undefer_Abort is called on any abortion completion point (aka.
+ -- Undefer_Abort is called on any abort completion point (aka.
-- synchronization point). It performs the following actions if they
-- are pending: (1) change the base priority, (2) abort the task.
- -- The priority change has to occur before abortion. Otherwise, it would
- -- take effect no earlier than the next abortion completion point.
+ -- The priority change has to occur before abort. Otherwise, it would
+ -- take effect no earlier than the next abort completion point.
procedure Undefer_Abort (Self_ID : Task_Id) is
begin
-- Undefer_Abortion --
----------------------
- -- Phase out RTS-internal use of Undefer_Abortion
- -- to reduce overhead due to multiple calls to Self.
+ -- Phase out RTS-internal use of Undefer_Abortion to reduce overhead due
+ -- to multiple calls to Self.
procedure Undefer_Abortion is
Self_ID : Task_Id;
-- Update_Exception --
----------------------
- -- Call only when holding no locks.
+ -- Call only when holding no locks
procedure Update_Exception
(X : AE.Exception_Occurrence := Current_Target_Exception)
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
package System.Tasking.Initialization is
procedure Remove_From_All_Tasks_List (T : Task_Id);
- -- Remove T from All_Tasks_List.
- -- Call this function with RTS_Lock taken.
+ -- Remove T from All_Tasks_List. Call this function with RTS_Lock taken
---------------------------------
-- Tasking-Specific Soft Links --
-- These permit us to leave out certain portions of the tasking
-- run-time system if they are not used. They are only used internally
-- by the tasking run-time system.
- -- So far, the only example is support for Ada.Task_Attributes.
+
+ -- So far, the only example is support for Ada.Task_Attributes
type Proc_T is access procedure (T : Task_Id);
procedure Initialize_Attributes (T : Task_Id);
Finalize_Attributes_Link : Proc_T := Finalize_Attributes'Access;
- -- should be called with abortion deferred and T.L write-locked
+ -- should be called with abort deferred and T.L write-locked
Initialize_Attributes_Link : Proc_T := Initialize_Attributes'Access;
- -- should be called with abortion deferred, but holding no locks
+ -- should be called with abort deferred, but holding no locks
-------------------------
-- Abort Defer/Undefer --
-- in the calling task until a matching Undefer_Abort call is executed.
-- Undefer_Abort DOES MORE than just undo the effects of one call to
- -- Defer_Abort. It is the universal "polling point" for deferred
+ -- Defer_Abort. It is the universal "polling point" for deferred
-- processing, including the following:
-- 1) base priority changes
-- 2) abort/ATC
- -- Abort deferral MAY be nested (Self_ID.Deferral_Level is a count),
- -- but to avoid waste and undetected errors, it generally SHOULD NOT
- -- be nested. The symptom of over-deferring abort is that an exception
- -- may fail to be raised, or an abort may fail to take place.
+ -- Abort deferral MAY be nested (Self_ID.Deferral_Level is a count), but
+ -- to avoid waste and undetected errors, it generally SHOULD NOT be
+ -- nested. The symptom of over-deferring abort is that an exception may
+ -- fail to be raised, or an abort may fail to take place.
- -- Therefore, there are two sets of the inlinable defer/undefer
- -- routines, which are the ones to be used inside GNARL.
- -- One set allows nesting. The other does not. People who
- -- maintain the GNARL should try to avoid using the nested versions,
- -- or at least look very critically at the places where they are
- -- used.
+ -- Therefore, there are two sets of the inlinable defer/undefer routines,
+ -- which are the ones to be used inside GNARL. One set allows nesting. The
+ -- other does not. People who maintain the GNARL should try to avoid using
+ -- the nested versions, or at least look very critically at the places
+ -- where they are used.
- -- In general, any GNARL call that is potentially blocking, or
- -- whose semantics require that it sometimes raise an exception,
- -- or that is required to be an abort completion point, must be
- -- made with abort Deferral_Level = 1.
+ -- In general, any GNARL call that is potentially blocking, or whose
+ -- semantics require that it sometimes raise an exception, or that is
+ -- required to be an abort completion point, must be made with abort
+ -- Deferral_Level = 1.
- -- In general, non-blocking GNARL calls, which may be made from inside
- -- a protected action, are likely to need to allow nested abort
- -- deferral.
+ -- In general, non-blocking GNARL calls, which may be made from inside a
+ -- protected action, are likely to need to allow nested abort deferral.
-- With some critical exceptions (which are supposed to be documented),
-- internal calls to the tasking runtime system assume abort is already
-- deferred, and do not modify the deferral level.
- -- There is also a set of non-linable defer/undefer routines,
- -- for direct call from the compiler. These are not in-lineable
- -- because they may need to be called via pointers ("soft links").
- -- For the sake of efficiency, the version with Self_ID as parameter
- -- should used wherever possible. These are all nestable.
+ -- There is also a set of non-linable defer/undefer routines, for direct
+ -- call from the compiler. These are not in-lineable because they may need
+ -- to be called via pointers ("soft links"). For the sake of efficiency,
+ -- the version with Self_ID as parameter should used wherever possible.
+ -- These are all nestable.
-- Non-nestable inline versions
procedure Defer_Abortion;
procedure Undefer_Abortion;
- -- ?????
- -- Try to phase out all uses of the above versions.
+ -- Try to phase out all uses of the above versions ???
procedure Do_Pending_Action (Self_ID : Task_Id);
- -- Only call with no locks, and when Self_ID.Pending_Action = True
- -- Perform necessary pending actions (e.g. abortion, priority change).
- -- This procedure is usually called when needed as a result of
- -- calling Undefer_Abort, although in the case of e.g. No_Abort
- -- restriction, it can be necessary to force execution of pending
- -- actions.
+ -- Only call with no locks, and when Self_ID.Pending_Action = True Perform
+ -- necessary pending actions (e.g. abort, priority change). This procedure
+ -- is usually called when needed as a result of calling Undefer_Abort,
+ -- although in the case of e.g. No_Abort restriction, it can be necessary
+ -- to force execution of pending actions.
function Check_Abort_Status return Integer;
-- Returns Boolean'Pos (True) iff abort signal should raise
--------------------------
procedure Change_Base_Priority (T : Task_Id);
- -- Change the base priority of T.
- -- Has to be called with the affected task's ATCB write-locked.
- -- May temporariliy release the lock.
+ -- Change the base priority of T. Has to be called with the affected
+ -- task's ATCB write-locked. May temporariliy release the lock.
procedure Poll_Base_Priority_Change (Self_ID : Task_Id);
-- Has to be called with Self_ID's ATCB write-locked.
-- within the GNARL.
procedure Final_Task_Unlock (Self_ID : Task_Id);
- -- This version is only for use in Terminate_Task, when the task
- -- is relinquishing further rights to its own ATCB.
- -- There is a very interesting potential race condition there, where
- -- the old task may run concurrently with a new task that is allocated
- -- the old tasks (now reused) ATCB. The critical thing here is to
- -- not make any reference to the ATCB after the lock is released.
- -- See also comments on Terminate_Task and Unlock.
+ -- This version is only for use in Terminate_Task, when the task is
+ -- relinquishing further rights to its own ATCB. There is a very
+ -- interesting potential race condition there, where the old task may run
+ -- concurrently with a new task that is allocated the old tasks (now
+ -- reused) ATCB. The critical thing here is to not make any reference to
+ -- the ATCB after the lock is released. See also comments on
+ -- Terminate_Task and Unlock.
procedure Wakeup_Entry_Caller
(Self_ID : Task_Id;
Entry_Call : Entry_Call_Link;
New_State : Entry_Call_State);
pragma Inline (Wakeup_Entry_Caller);
- -- This is called at the end of service of an entry call,
- -- to abort the caller if he is in an abortable part, and
- -- to wake up the caller if he is on Entry_Caller_Sleep.
- -- Call it holding the lock of Entry_Call.Self.
+ -- This is called at the end of service of an entry call, to abort the
+ -- caller if he is in an abortable part, and to wake up the caller if he
+ -- is on Entry_Caller_Sleep. Call it holding the lock of Entry_Call.Self.
--
-- Timed_Call or Simple_Call:
- -- The caller is waiting on Entry_Caller_Sleep, in
- -- Wait_For_Completion, or Wait_For_Completion_With_Timeout.
+ -- The caller is waiting on Entry_Caller_Sleep, in Wait_For_Completion,
+ -- or Wait_For_Completion_With_Timeout.
--
-- Conditional_Call:
-- The caller might be in Wait_For_Completion,
- -- waiting for a rendezvous (possibly requeued without abort)
- -- to complete.
+ -- waiting for a rendezvous (possibly requeued without abort) to
+ -- complete.
--
-- Asynchronous_Call:
- -- The caller may be executing in the abortable part o
- -- an async. select, or on a time delay,
- -- if Entry_Call.State >= Was_Abortable.
+ -- The caller may be executing in the abortable part an async. select,
+ -- or on a time delay, if Entry_Call.State >= Was_Abortable.
procedure Locked_Abort_To_Level
(Self_ID : Task_Id;
T : Task_Id;
L : ATC_Level);
pragma Inline (Locked_Abort_To_Level);
- -- Abort a task to a specified ATC level.
- -- Call this only with T locked.
+ -- Abort a task to a specified ATC level. Call this only with T locked
end System.Tasking.Initialization;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This package provides necessary type definitions for compiler interface.
+-- This package provides necessary type definitions for compiler interface
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes.
-- The following rules must be followed at all times, to prevent
-- deadlock and generally ensure correct operation of locking.
- -- . Never lock a lock unless abort is deferred.
+ -- Never lock a lock unless abort is deferred
- -- . Never undefer abort while holding a lock.
+ -- Never undefer abort while holding a lock
- -- . Overlapping critical sections must be properly nested,
- -- and locks must be released in LIFO order.
- -- e.g., the following is not allowed:
+ -- Overlapping critical sections must be properly nested, and locks must
+ -- be released in LIFO order. e.g., the following is not allowed:
-- Lock (X);
-- ...
-- Locks with lower (smaller) level number cannot be locked
-- while holding a lock with a higher level number. (The level
- -- number is the number at the left.)
-- 1. System.Tasking.PO_Simple.Protection.L (any PO lock)
-- 2. System.Tasking.Initialization.Global_Task_Lock (in body)
-- clearly wrong since there can be calls to "new" inside protected
-- operations. The new ordering prevents these failures.
- -- Sometimes we need to hold two ATCB locks at the same time. To allow
- -- us to order the locking, each ATCB is given a unique serial
- -- number. If one needs to hold locks on several ATCBs at once,
- -- the locks with lower serial numbers must be locked first.
+ -- Sometimes we need to hold two ATCB locks at the same time. To allow us
+ -- to order the locking, each ATCB is given a unique serial number. If one
+ -- needs to hold locks on several ATCBs at once, the locks with lower
+ -- serial numbers must be locked first.
- -- We don't always need to check the serial numbers, since
- -- the serial numbers are assigned sequentially, and so:
+ -- We don't always need to check the serial numbers, since the serial
+ -- numbers are assigned sequentially, and so:
-- . The parent of a task always has a lower serial number.
-- . The activator of a task always has a lower serial number.
-- alternatives have been awakened and have terminated themselves.
Activator_Sleep,
- -- Task is waiting for created tasks to complete activation.
+ -- Task is waiting for created tasks to complete activation
Acceptor_Sleep,
- -- Task is waiting on an accept or selective wait statement.
+ -- Task is waiting on an accept or selective wait statement
Entry_Caller_Sleep,
- -- Task is waiting on an entry call.
+ -- Task is waiting on an entry call
Async_Select_Sleep,
-- Task is waiting to start the abortable part of an
State : Entry_Call_State;
pragma Atomic (State);
-- Indicates part of the state of the call.
- -- Protection:
- -- If the call is not on a queue, it should
- -- only be accessed by Self, and Self does not need any
- -- lock to modify this field.
- -- Once the call is on a queue, the value should be
- -- something other than Done unless it is cancelled, and access is
- -- controller by the "server" of the queue -- i.e., the lock
- -- of Checked_To_Protection (Call_Target)
- -- if the call record is on the queue of a PO, or the lock
- -- of Called_Target if the call is on the queue of a task.
- -- See comments on type declaration for more details.
+ --
+ -- Protection: If the call is not on a queue, it should only be
+ -- accessed by Self, and Self does not need any lock to modify this
+ -- field.
+ --
+ -- Once the call is on a queue, the value should be something other
+ -- than Done unless it is cancelled, and access is controller by the
+ -- "server" of the queue -- i.e., the lock of Checked_To_Protection
+ -- (Call_Target) if the call record is on the queue of a PO, or the
+ -- lock of Called_Target if the call is on the queue of a task. See
+ -- comments on type declaration for more details.
Uninterpreted_Data : System.Address;
- -- Data passed by the compiler.
+ -- Data passed by the compiler
Exception_To_Raise : Ada.Exceptions.Exception_Id;
-- The exception to raise once this call has been completed without
-- Ada_Task_Control_Block (ATCB) definition --
----------------------------------------------
- -- Notes on protection (synchronization) of TRTS data structures.
+ -- Notes on protection (synchronization) of TRTS data structures
-- Any field of the TCB can be written by the activator of a task when the
-- task is created, since no other task can access the new task's
-- The protection for each field is described in a comment starting with
-- "Protection:".
- -- When a lock is used to protect an ATCB field, this lock is simply named.
+ -- When a lock is used to protect an ATCB field, this lock is simply named
-- Some protection is described in terms of tasks related to the
-- ATCB being protected. These are:
-- Encodes some basic information about the state of a task,
-- including whether it has been activated, whether it is sleeping,
-- and whether it is terminated.
- -- Protection: Self.L.
+ --
+ -- Protection: Self.L
Parent : Task_Id;
-- The task on which this task depends.
Base_Priority : System.Any_Priority;
-- Base priority, not changed during entry calls, only changed
-- via dynamic priorities package.
- -- Protection: Only written by Self, accessed by anyone.
+ --
+ -- Protection: Only written by Self, accessed by anyone
Current_Priority : System.Any_Priority;
-- Active priority, except that the effects of protected object
Protected_Action_Nesting : Natural;
pragma Atomic (Protected_Action_Nesting);
- -- The dynamic level of protected action nesting for this task.
- -- This field is needed for checking whether potentially
- -- blocking operations are invoked from protected actions.
- -- pragma Atomic is used because it can be read/written from
- -- protected interrupt handlers.
+ -- The dynamic level of protected action nesting for this task. This
+ -- field is needed for checking whether potentially blocking operations
+ -- are invoked from protected actions. pragma Atomic is used because it
+ -- can be read/written from protected interrupt handlers.
Task_Image : String (1 .. 32);
-- Hold a string that provides a readable id for task,
-- built from the variable of which it is a value or component.
Task_Image_Len : Natural;
- -- Actual length of Task_Image.
+ -- Actual length of Task_Image
Call : Entry_Call_Link;
-- The entry call that has been accepted by this task.
- -- Protection: Self.L. Self will modify this field
- -- when Self.Accepting is False, and will not need the mutex to do so.
- -- Once a task sets Pending_ATC_Level = 0, no other task can access
- -- this field.
+ --
+ -- Protection: Self.L. Self will modify this field when Self.Accepting
+ -- is False, and will not need the mutex to do so. Once a task sets
+ -- Pending_ATC_Level = 0, no other task can access this field.
LL : aliased Task_Primitives.Private_Data;
- -- Control block used by the underlying low-level tasking
- -- service (GNULLI).
+ -- Control block used by the underlying low-level tasking service
+ -- (GNULLI).
+ --
-- Protection: This is used only by the GNULLI implementation, which
-- takes care of all of its synchronization.
Task_Arg : System.Address;
-- The argument to task procedure. Provide a handle for discriminant
- -- information.
- -- Protection: Part of the synchronization between Self and
- -- Activator. Activator writes it, once, before Self starts
- -- executing. Thereafter, Self only reads it.
+ -- information
+ --
+ -- Protection: Part of the synchronization between Self and Activator.
+ -- Activator writes it, once, before Self starts executing. Thereafter,
+ -- Self only reads it.
Task_Entry_Point : Task_Procedure_Access;
-- Information needed to call the procedure containing the code for
-- the body of this task.
- -- Protection: Part of the synchronization between Self and
- -- Activator. Activator writes it, once, before Self starts
- -- executing. Self reads it, once, as part of its execution.
+ --
+ -- Protection: Part of the synchronization between Self and Activator.
+ -- Activator writes it, once, before Self starts executing. Self reads
+ -- it, once, as part of its execution.
Compiler_Data : System.Soft_Links.TSD;
- -- Task-specific data needed by the compiler to store
- -- per-task structures.
- -- Protection: Only accessed by Self.
+ -- Task-specific data needed by the compiler to store per-task
+ -- structures.
+ --
+ -- Protection: Only accessed by Self
All_Tasks_Link : Task_Id;
- -- Used to link this task to the list of all tasks in the system.
- -- Protection: RTS_Lock.
+ -- Used to link this task to the list of all tasks in the system
+ --
+ -- Protection: RTS_Lock
Activation_Link : Task_Id;
- -- Used to link this task to a list of tasks to be activated.
- -- Protection: Only used by Activator.
+ -- Used to link this task to a list of tasks to be activated
+ --
+ -- Protection: Only used by Activator
Activator : Task_Id;
-- The task that created this task, either by declaring it as a task
- -- object or by executing a task allocator.
- -- The value is null iff Self has completed activation.
- -- Protection: Set by Activator before Self is activated, and
- -- only read and modified by Self after that.
+ -- object or by executing a task allocator. The value is null iff Self
+ -- has completed activation.
+ --
+ -- Protection: Set by Activator before Self is activated, and only read
+ -- and modified by Self after that.
Wait_Count : Integer;
- -- This count is used by a task that is waiting for other tasks.
- -- At all other times, the value should be zero.
- -- It is used differently in several different states.
- -- Since a task cannot be in more than one of these states at the
- -- same time, a single counter suffices.
- -- Protection: Self.L.
+ -- This count is used by a task that is waiting for other tasks. At all
+ -- other times, the value should be zero. It is used differently in
+ -- several different states. Since a task cannot be in more than one of
+ -- these states at the same time, a single counter suffices.
+ --
+ -- Protection: Self.L
-- Activator_Sleep
-- This is the number of tasks that this task is activating, i.e. the
-- children that have started activation but have not completed it.
- -- Protection: Self.L and Created.L. Both mutexes must be locked,
- -- since Self.Activation_Count and Created.State must be synchronized.
+ --
+ -- Protection: Self.L and Created.L. Both mutexes must be locked, since
+ -- Self.Activation_Count and Created.State must be synchronized.
-- Master_Completion_Sleep (phase 1)
- -- This is the number dependent tasks of a master being
- -- completed by Self that are not activated, not terminated, and
- -- not waiting on a terminate alternative.
+ -- This is the number dependent tasks of a master being completed by
+ -- Self that are not activated, not terminated, and not waiting on a
+ -- terminate alternative.
-- Master_Completion_2_Sleep (phase 2)
- -- This is the count of tasks dependent on a master being
- -- completed by Self which are waiting on a terminate alternative.
+ -- This is the count of tasks dependent on a master being completed by
+ -- Self which are waiting on a terminate alternative.
Elaborated : Access_Boolean;
-- Pointer to a flag indicating that this task's body has been
-- elaborated. The flag is created and managed by the
-- compiler-generated code.
+ --
-- Protection: The field itself is only accessed by Activator. The flag
-- that it points to is updated by Master and read by Activator; access
-- is assumed to be atomic.
-- restricted GNULL implementations to allocate an ATCB (see
-- System.Task_Primitives.Operations.New_ATCB) that will take
-- significantly less memory.
+
-- Note that the restricted GNARLI should only access fields that are
-- present in the Restricted_Ada_Task_Control_Block structure.
-----------------------
All_Tasks_List : Task_Id;
- -- Global linked list of all tasks.
+ -- Global linked list of all tasks
------------------------------------------
-- Regular (non restricted) definitions --
subtype Master_Level is Integer;
subtype Master_ID is Master_Level;
- -- Normally, a task starts out with internal master nesting level
- -- one larger than external master nesting level. It is incremented
- -- to one by Enter_Master, which is called in the task body only if
- -- the compiler thinks the task may have dependent tasks. It is set to 1
- -- for the environment task, the level 2 is reserved for server tasks of
- -- the run-time system (the so called "independent tasks"), and the level
- -- 3 is for the library level tasks.
+ -- Normally, a task starts out with internal master nesting level one
+ -- larger than external master nesting level. It is incremented to one by
+ -- Enter_Master, which is called in the task body only if the compiler
+ -- thinks the task may have dependent tasks. It is set to for the
+ -- environment task, the level 2 is reserved for server tasks of the
+ -- run-time system (the so called "independent tasks"), and the level 3 is
+ -- for the library level tasks.
Environment_Task_Level : constant Master_Level := 1;
Independent_Task_Level : constant Master_Level := 2;
Unspecified_Priority : constant Integer := System.Priority'First - 1;
Priority_Not_Boosted : constant Integer := System.Priority'First - 1;
- -- Definition of Priority actually has to come from the RTS configuration.
+ -- Definition of Priority actually has to come from the RTS configuration
subtype Rendezvous_Priority is Integer
range Priority_Not_Boosted .. System.Any_Priority'Last;
State : Entry_Call_State;
pragma Atomic (State);
- -- Indicates part of the state of the call.
- -- Protection:
- -- If the call is not on a queue, it should
- -- only be accessed by Self, and Self does not need any
- -- lock to modify this field.
- -- Once the call is on a queue, the value should be
- -- something other than Done unless it is cancelled, and access is
- -- controller by the "server" of the queue -- i.e., the lock
- -- of Checked_To_Protection (Call_Target)
- -- if the call record is on the queue of a PO, or the lock
- -- of Called_Target if the call is on the queue of a task.
- -- See comments on type declaration for more details.
+ -- Indicates part of the state of the call
+ --
+ -- Protection: If the call is not on a queue, it should only be
+ -- accessed by Self, and Self does not need any lock to modify this
+ -- field. Once the call is on a queue, the value should be something
+ -- other than Done unless it is cancelled, and access is controller by
+ -- the "server" of the queue -- i.e., the lock of Checked_To_Protection
+ -- (Call_Target) if the call record is on the queue of a PO, or the
+ -- lock of Called_Target if the call is on the queue of a task. See
+ -- comments on type declaration for more details.
Uninterpreted_Data : System.Address;
- -- Data passed by the compiler.
+ -- Data passed by the compiler
Exception_To_Raise : Ada.Exceptions.Exception_Id;
-- The exception to raise once this call has been completed without
Called_Task : Task_Id;
pragma Atomic (Called_Task);
- -- Use for task entry calls.
- -- The value is null if the call record is not in use.
- -- Conversely, unless State is Done and Onqueue is false,
+ -- Use for task entry calls. The value is null if the call record is
+ -- not in use. Conversely, unless State is Done and Onqueue is false,
-- Called_Task points to an ATCB.
- -- Protection: Called_Task.L.
+ --
+ -- Protection: Called_Task.L
Called_PO : System.Address;
pragma Atomic (Called_PO);
- -- Similar to Called_Task but for protected objects.
+ -- Similar to Called_Task but for protected objects
+ --
-- Note that the previous implementation tried to merge both
-- Called_Task and Called_PO but this ended up in many unexpected
-- complications (e.g having to add a magic number in the ATCB, which
- -- caused gdb lots of confusion) with no real gain since the Lock_Server
- -- implementation still need to loop around chasing for pointer changes
- -- even with a single pointer.
+ -- caused gdb lots of confusion) with no real gain since the
+ -- Lock_Server implementation still need to loop around chasing for
+ -- pointer changes even with a single pointer.
Acceptor_Prev_Call : Entry_Call_Link;
- -- For task entry calls only.
+ -- For task entry calls only
Acceptor_Prev_Priority : Rendezvous_Priority := Priority_Not_Boosted;
- -- For task entry calls only.
- -- The priority of the most recent prior call being serviced.
- -- For protected entry calls, this function should be performed by
- -- GNULLI ceiling locking.
+ -- For task entry calls only. The priority of the most recent prior
+ -- call being serviced. For protected entry calls, this function should
+ -- be performed by GNULLI ceiling locking.
Cancellation_Attempted : Boolean := False;
pragma Atomic (Cancellation_Attempted);
-- Cancellation of the call has been attempted.
- -- If it has succeeded, State = Cancelled.
- -- ?????
- -- Consider merging this into State?
+ -- Consider merging this into State???
Requeue_With_Abort : Boolean := False;
-- Temporary to tell caller whether requeue is with abort.
- -- ?????
- -- Find a better way of doing this.
+ -- Find a better way of doing this ???
Needs_Requeue : Boolean := False;
-- Temporary to tell acceptor of task entry call that
type Direct_Index is range 0 .. Parameters.Default_Attribute_Count;
subtype Direct_Index_Range is Direct_Index range 1 .. Direct_Index'Last;
- -- Attributes with indices in this range are stored directly in
- -- the task control block. Such attributes must be Address-sized.
- -- Other attributes will be held in dynamically allocated records
- -- chained off of the task control block.
+ -- Attributes with indices in this range are stored directly in the task
+ -- control block. Such attributes must be Address-sized. Other attributes
+ -- will be held in dynamically allocated records chained off of the task
+ -- control block.
type Direct_Attribute_Element is mod Memory_Size;
pragma Atomic (Direct_Attribute_Element);
-- the usage of the direct attribute fields.
type Task_Serial_Number is mod 2 ** 64;
- -- Used to give each task a unique serial number.
+ -- Used to give each task a unique serial number
type Ada_Task_Control_Block (Entry_Num : Task_Entry_Index) is record
Common : Common_ATCB;
-- The common part between various tasking implementations
Entry_Calls : Entry_Call_Array;
- -- An array of entry calls.
+ -- An array of entry calls
+ --
-- Protection: The elements of this array are on entry call queues
-- associated with protected objects or task entries, and are protected
-- by the protected object lock or Acceptor.L, respectively.
New_Base_Priority : System.Any_Priority;
- -- New value for Base_Priority (for dynamic priorities package).
- -- Protection: Self.L.
+ -- New value for Base_Priority (for dynamic priorities package)
+ --
+ -- Protection: Self.L
Global_Task_Lock_Nesting : Natural := 0;
-- This is the current nesting level of calls to
- -- System.Tasking.Stages.Lock_Task_T.
- -- This allows a task to call Lock_Task_T multiple times without
- -- deadlocking. A task only locks All_Task_Lock when its
- -- All_Tasks_Nesting goes from 0 to 1, and only unlocked when it
- -- goes from 1 to 0.
- -- Protection: Only accessed by Self.
+ -- System.Tasking.Stages.Lock_Task_T. This allows a task to call
+ -- Lock_Task_T multiple times without deadlocking. A task only locks
+ -- All_Task_Lock when its All_Tasks_Nesting goes from 0 to 1, and only
+ -- unlocked when it goes from 1 to 0.
+ --
+ -- Protection: Only accessed by Self
Open_Accepts : Accept_List_Access;
-- This points to the Open_Accepts array of accept alternatives passed
- -- to the RTS by the compiler-generated code to Selective_Wait.
- -- It is non-null iff this task is ready to accept an entry call.
- -- Protection: Self.L.
+ -- to the RTS by the compiler-generated code to Selective_Wait. It is
+ -- non-null iff this task is ready to accept an entry call.
+ --
+ -- Protection: Self.L
Chosen_Index : Select_Index;
-- The index in Open_Accepts of the entry call accepted by a selective
-- wait executed by this task.
- -- Protection: Written by both Self and Caller. Usually protected
- -- by Self.L. However, once the selection is known to have been
- -- written it can be accessed without protection. This happens
- -- after Self has updated it itself using information from a suspended
- -- Caller, or after Caller has updated it and awakened Self.
+ --
+ -- Protection: Written by both Self and Caller. Usually protected by
+ -- Self.L. However, once the selection is known to have been written it
+ -- can be accessed without protection. This happens after Self has
+ -- updated it itself using information from a suspended Caller, or
+ -- after Caller has updated it and awakened Self.
Master_of_Task : Master_Level;
-- The task executing the master of this task, and the ID of this task's
-- master (unique only among masters currently active within Parent).
- -- Protection: Set by Activator before Self is activated, and
- -- read after Self is activated.
+ --
+ -- Protection: Set by Activator before Self is activated, and read
+ -- after Self is activated.
Master_Within : Master_Level;
-- The ID of the master currently executing within this task; that is,
-- the most deeply nested currently active master.
+ --
-- Protection: Only written by Self, and only read by Self or by
- -- dependents when Self is attempting to exit a master. Since Self
- -- will not write this field until the master is complete, the
+ -- dependents when Self is attempting to exit a master. Since Self will
+ -- not write this field until the master is complete, the
-- synchronization should be adequate to prevent races.
Alive_Count : Integer := 0;
-- Number of tasks directly dependent on this task (including itself)
-- that are still "alive", i.e. not terminated.
- -- Protection: Self.L.
+ --
+ -- Protection: Self.L
Awake_Count : Integer := 0;
-- Number of tasks directly dependent on this task (including itself)
-- still "awake", i.e., are not terminated and not waiting on a
-- terminate alternative.
+ --
-- Invariant: Awake_Count <= Alive_Count
- -- Protection: Self.L.
- -- beginning of flags
+ -- Protection: Self.L
+
+ -- Beginning of flags
Aborting : Boolean := False;
pragma Atomic (Aborting);
-- Self is in the process of aborting. While set, prevents multiple
- -- abortion signals from being sent by different aborter while abortion
+ -- abort signals from being sent by different aborter while abort
-- is acted upon. This is essential since an aborter which calls
-- Abort_To_Level could set the Pending_ATC_Level to yet a lower level
-- (than the current level), may be preempted and would send the
- -- abortion signal when resuming execution. At this point, the abortee
- -- may have completed abortion to the proper level such that the
- -- signal (and resulting abortion exception) are not handled any more.
+ -- abort signal when resuming execution. At this point, the abortee
+ -- may have completed abort to the proper level such that the
+ -- signal (and resulting abort exception) are not handled any more.
-- In other words, the flag prevents a race between multiple aborters
- -- and the abortee.
+ --
-- Protection: protected by atomic access.
ATC_Hack : Boolean := False;
-- handler itself.
Callable : Boolean := True;
- -- It is OK to call entries of this task.
+ -- It is OK to call entries of this task
Dependents_Aborted : Boolean := False;
- -- This is set to True by whichever task takes responsibility
- -- for aborting the dependents of this task.
- -- Protection: Self.L.
+ -- This is set to True by whichever task takes responsibility for
+ -- aborting the dependents of this task.
+ --
+ -- Protection: Self.L
Interrupt_Entry : Boolean := False;
- -- Indicates if one or more Interrupt Entries are attached to
- -- the task. This flag is needed for cleaning up the Interrupt
- -- Entry bindings.
+ -- Indicates if one or more Interrupt Entries are attached to the task.
+ -- This flag is needed for cleaning up the Interrupt Entry bindings.
Pending_Action : Boolean := False;
-- Unified flag indicating some action needs to be take when abort
-- (Abortable field may have changed and the Wait_Until_Abortable
-- has to recheck the abortable status of the call.)
-- . Exception_To_Raise is non-null
- -- Protection: Self.L.
- -- This should never be reset back to False outside of the
- -- procedure Do_Pending_Action, which is called by Undefer_Abort.
- -- It should only be set to True by Set_Priority and Abort_To_Level.
+ --
+ -- Protection: Self.L
+ --
+ -- This should never be reset back to False outside of the procedure
+ -- Do_Pending_Action, which is called by Undefer_Abort. It should only
+ -- be set to True by Set_Priority and Abort_To_Level.
Pending_Priority_Change : Boolean := False;
-- Flag to indicate pending priority change (for dynamic priorities
- -- package). The base priority is updated on the next abortion
+ -- package). The base priority is updated on the next abort
-- completion point (aka. synchronization point).
- -- Protection: Self.L.
+ --
+ -- Protection: Self.L
Terminate_Alternative : Boolean := False;
- -- Task is accepting Select with Terminate Alternative.
- -- Protection: Self.L.
+ -- Task is accepting Select with Terminate Alternative
+ --
+ -- Protection: Self.L
- -- end of flags
+ -- End of flags
- -- beginning of counts
+ -- Beginning of counts
ATC_Nesting_Level : ATC_Level := 1;
-- The dynamic level of ATC nesting (currently executing nested
-- asynchronous select statements) in this task.
- -- Protection: Self_ID.L.
- -- Only Self reads or updates this field.
+
+ -- Protection: Self_ID.L. Only Self reads or updates this field.
-- Decrementing it deallocates an Entry_Calls component, and care must
- -- be taken that all references to that component are eliminated
- -- before doing the decrement. This in turn will require locking
- -- a protected object (for a protected entry call) or the Acceptor's
- -- lock (for a task entry call).
- -- No other task should attempt to read or modify this value.
+ -- be taken that all references to that component are eliminated before
+ -- doing the decrement. This in turn will require locking a protected
+ -- object (for a protected entry call) or the Acceptor's lock (for a
+ -- task entry call). No other task should attempt to read or modify
+ -- this value.
Deferral_Level : Natural := 1;
-- This is the number of times that Defer_Abortion has been called by
- -- this task without a matching Undefer_Abortion call. Abortion is
- -- only allowed when this zero.
- -- It is initially 1, to protect the task at startup.
- -- Protection: Only updated by Self; access assumed to be atomic.
+ -- this task without a matching Undefer_Abortion call. Abortion is only
+ -- allowed when this zero. It is initially 1, to protect the task at
+ -- startup.
+
+ -- Protection: Only updated by Self; access assumed to be atomic
Pending_ATC_Level : ATC_Level_Base := ATC_Level_Infinity;
- -- The ATC level to which this task is currently being aborted.
- -- If the value is zero, the entire task has "completed".
- -- That may be via abort, exception propagation, or normal exit.
- -- If the value is ATC_Level_Infinity, the task is not being
- -- aborted to any level.
- -- If the value is positive, the task has not completed.
- -- This should ONLY be modified by
- -- Abort_To_Level and Exit_One_ATC_Level.
- -- Protection: Self.L.
+ -- The ATC level to which this task is currently being aborted. If the
+ -- value is zero, the entire task has "completed". That may be via
+ -- abort, exception propagation, or normal exit. If the value is
+ -- ATC_Level_Infinity, the task is not being aborted to any level. If
+ -- the value is positive, the task has not completed. This should ONLY
+ -- be modified by Abort_To_Level and Exit_One_ATC_Level.
+ --
+ -- Protection: Self.L
Serial_Number : Task_Serial_Number;
- -- A growing number to provide some way to check locking
- -- rules/ordering.
+ -- A growing number to provide some way to check locking rules/ordering
Known_Tasks_Index : Integer := -1;
- -- Index in the System.Tasking.Debug.Known_Tasks array.
+ -- Index in the System.Tasking.Debug.Known_Tasks array
User_State : Long_Integer := 0;
- -- User-writeable location, for use in debugging tasks;
- -- also provides a simple task specific data.
+ -- User-writeable location, for use in debugging tasks; also provides a
+ -- simple task specific data.
Direct_Attributes : Direct_Attribute_Array;
-- For task attributes that have same size as Address
-- Bit I is 1 iff Direct_Attributes (I) is defined
Indirect_Attributes : Access_Address;
- -- A pointer to chain of records for other attributes that
- -- are not address-sized, including all tagged types.
+ -- A pointer to chain of records for other attributes that are not
+ -- address-sized, including all tagged types.
Entry_Queues : Task_Entry_Queue_Array (1 .. Entry_Num);
- -- An array of task entry queues.
+ -- An array of task entry queues
+ --
-- Protection: Self.L. Once a task has set Self.Stage to Completing, it
-- has exclusive access to this field.
end record;
Stack_Size : System.Parameters.Size_Type;
T : Task_Id;
Success : out Boolean);
- -- Initialize fields of a TCB and link into global TCB structures
- -- Call this only with abort deferred and holding RTS_Lock.
- -- Need more documentation, mention T, and describe Success ???
+ -- Initialize fields of a TCB and link into global TCB structures Call
+ -- this only with abort deferred and holding RTS_Lock. Need more
+ -- documentation, mention T, and describe Success ???
private
Null_Task : constant Task_Id := null;
GL_Detect_Blocking : Integer;
pragma Import (C, GL_Detect_Blocking, "__gl_detect_blocking");
- -- Global variable exported by the binder generated file. A value
- -- equal to 1 indicates that pragma Detect_Blocking is active,
- -- while 0 is used for the pragma not being present.
+ -- Global variable exported by the binder generated file. A value equal to
+ -- 1 indicates that pragma Detect_Blocking is active, while 0 is used for
+ -- the pragma not being present.
Detect_Blocking : constant Boolean := GL_Detect_Blocking = 1;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
pragma Inline (Boost_Priority);
- -- Call this only with abort deferred and holding lock of Acceptor.
+ -- Call this only with abort deferred and holding lock of Acceptor
procedure Call_Synchronous
(Acceptor : Task_Id;
Uninterpreted_Data :=
Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
else
- -- Case of an aborted task.
+ -- Case of an aborted task
Uninterpreted_Data := System.Null_Address;
end if;
(Self_Id, Entry_Call.Acceptor_Prev_Priority);
else
- -- The call does not need to be requeued.
+ -- The call does not need to be requeued
Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
Entry_Call.Exception_To_Raise := Ex;
STPO.Write_Lock (Caller);
- -- Done with Caller locked to make sure that Wakeup is not lost.
+ -- Done with Caller locked to make sure that Wakeup is not lost
if Ex /= Ada.Exceptions.Null_Id then
Transfer_Occurrence
Queuing.Select_Task_Entry_Call
(Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
- -- Determine the kind and disposition of the select.
+ -- Determine the kind and disposition of the select
Treatment := Default_Treatment (Select_Mode);
Self_Id.Chosen_Index := No_Rendezvous;
end if;
end if;
- -- Handle the select according to the disposition selected above.
+ -- Handle the select according to the disposition selected above
case Treatment is
when Accept_Alternative_Selected =>
STPO.Unlock (Self_Id);
when Accept_Alternative_Completed =>
- -- Accept body is null, so rendezvous is over immediately.
+
+ -- Accept body is null, so rendezvous is over immediately
if Parameters.Runtime_Traces then
Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
STPO.Unlock (Caller);
when Accept_Alternative_Open =>
- -- Wait for caller.
+
+ -- Wait for caller
Self_Id.Open_Accepts := Open_Accepts;
pragma Debug
-- Self_Id.Common.Call should already be updated by the Caller if
-- not aborted. It might also be ready to do rendezvous even if
- -- this wakes up due to an abortion.
- -- Therefore, if the call is not empty we need to do the
- -- rendezvous if the accept body is not Null_Body.
+ -- this wakes up due to an abort. Therefore, if the call is not
+ -- empty we need to do the rendezvous if the accept body is not
+ -- Null_Body.
-- Aren't the first two conditions below redundant???
Self_Id.Open_Accepts := Open_Accepts;
Self_Id.Common.State := Acceptor_Sleep;
- -- Notify ancestors that this task is on a terminate alternative.
+ -- Notify ancestors that this task is on a terminate alternative
STPO.Unlock (Self_Id);
Utilities.Make_Passive (Self_Id, Task_Completed => False);
STPO.Write_Lock (Acceptor);
- -- If the acceptor is not callable, abort the call and return False.
+ -- If the acceptor is not callable, abort the call and return False
if not Acceptor.Callable then
STPO.Unlock (Acceptor);
return False;
end if;
- -- Try to serve the call immediately.
+ -- Try to serve the call immediately
if Acceptor.Open_Accepts /= null then
for J in Acceptor.Open_Accepts'Range loop
if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then
- -- Commit acceptor to rendezvous with us.
+ -- Commit acceptor to rendezvous with us
Acceptor.Chosen_Index := J;
Null_Body := Acceptor.Open_Accepts (J).Null_Body;
Acceptor.Open_Accepts := null;
- -- Prevent abort while call is being served.
+ -- Prevent abort while call is being served
if Entry_Call.State = Now_Abortable then
Entry_Call.State := Was_Abortable;
end if;
if Acceptor.Terminate_Alternative then
- -- Cancel terminate alternative.
- -- See matching code in Selective_Wait and
- -- Vulnerable_Complete_Master.
+
+ -- Cancel terminate alternative. See matching code in
+ -- Selective_Wait and Vulnerable_Complete_Master.
Acceptor.Terminate_Alternative := False;
Acceptor.Awake_Count := Acceptor.Awake_Count + 1;
if Acceptor.Awake_Count = 1 then
- -- Notify parent that acceptor is awake.
+ -- Notify parent that acceptor is awake
pragma Assert (Parent.Awake_Count > 0);
end if;
if Null_Body then
- -- Rendezvous is over immediately.
+
+ -- Rendezvous is over immediately
STPO.Wakeup (Acceptor, Acceptor_Sleep);
STPO.Unlock (Acceptor);
else
Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor);
- -- For terminate_alternative, acceptor may not be
- -- asleep yet, so we skip the wakeup
+ -- For terminate_alternative, acceptor may not be asleep
+ -- yet, so we skip the wakeup
if Acceptor.Common.State /= Runnable then
STPO.Wakeup (Acceptor, Acceptor_Sleep);
end if;
end loop;
- -- The acceptor is accepting, but not this entry.
+ -- The acceptor is accepting, but not this entry
end if;
-- If the acceptor was ready to accept this call,
else
-- This is an asynchronous call
- -- Abortion must already be deferred by the compiler-generated
- -- code. Without this, an abortion that occurs between the time
- -- that this call is made and the time that the abortable part's
- -- cleanup handler is set up might miss the cleanup handler and
- -- leave the call pending.
+ -- Abort must already be deferred by the compiler-generated code.
+ -- Without this, an abort that occurs between the time that this
+ -- call is made and the time that the abortable part's cleanup
+ -- handler is set up might miss the cleanup handler and leave the
+ -- call pending.
Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
pragma Debug
Unlock_RTS;
end if;
- -- Note: following assignment needs to be atomic.
+ -- Note: following assignment needs to be atomic
Rendezvous_Successful := Entry_Call.State = Done;
end if;
Queuing.Select_Task_Entry_Call
(Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
- -- Determine the kind and disposition of the select.
+ -- Determine the kind and disposition of the select
Treatment := Default_Treatment (Select_Mode);
Self_Id.Chosen_Index := No_Rendezvous;
end if;
end if;
- -- Handle the select according to the disposition selected above.
+ -- Handle the select according to the disposition selected above
case Treatment is
when Accept_Alternative_Selected =>
STPO.Unlock (Caller);
when Accept_Alternative_Open =>
- -- Wait for caller.
+
+ -- Wait for caller
Self_Id.Open_Accepts := Open_Accepts;
-- Wakeup_Time is reached.
-- Try to remove calls to Sleep in the loop below by letting the
- -- caller a chance of getting ready immediately, using Unlock &
- -- Yield.
- -- See similar action in Wait_For_Completion & Wait_For_Call.
+ -- caller a chance of getting ready immediately, using Unlock
+ -- Yield. See similar action in Wait_For_Completion/Wait_For_Call.
if Single_Lock then
Unlock_RTS;
-- Self_Id.Common.Call should already be updated by the Caller if
-- not aborted. It might also be ready to do rendezvous even if
- -- this wakes up due to an abortion.
- -- Therefore, if the call is not empty we need to do the
- -- rendezvous if the accept body is not Null_Body.
+ -- this wakes up due to an abort. Therefore, if the call is not
+ -- empty we need to do the rendezvous if the accept body is not
+ -- Null_Body.
if Self_Id.Chosen_Index /= No_Rendezvous
and then Self_Id.Common.Call /= null
-- for several reasons:
-- 1) Delay is expired
-- 2) Pending_Action needs to be checked
- -- (Abortion, Priority change)
+ -- (Abort, Priority change)
-- 3) Spurious wakeup
Self_Id.Open_Accepts := null;
Entry_Call.Called_PO := Null_Address;
Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
- -- Note: the caller will undefer abortion on return (see WARNING above)
+ -- Note: the caller will undefer abort on return (see WARNING above)
if Single_Lock then
Lock_RTS;
Write_Lock (Self_Id);
end if;
- -- Check if this task has been aborted while the lock was released.
+ -- Check if this task has been aborted while the lock was released
if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
Self_Id.Open_Accepts := null;
-- tasking operations. It causes infinite loops and other problems.
with Ada.Exceptions;
--- used for Raise_Exception
+-- Used for Raise_Exception
with System.Tasking.Debug;
--- used for enabling tasking facilities with gdb
+-- Used for enabling tasking facilities with gdb
with System.Address_Image;
--- used for the function itself.
+-- Used for the function itself
with System.Parameters;
--- used for Size_Type
+-- Used for Size_Type
-- Single_Lock
-- Runtime_Traces
with System.Task_Info;
--- used for Task_Info_Type
+-- Used for Task_Info_Type
with System.Task_Primitives.Operations;
--- used for Finalize_Lock
+-- Used for Finalize_Lock
-- Enter_Task
-- Write_Lock
-- Unlock
-- New_ATCB
with System.Soft_Links;
--- These are procedure pointers to non-tasking routines that use
--- task specific data. In the absence of tasking, these routines
--- refer to global data. In the presense of tasking, they must be
--- replaced with pointers to task-specific versions.
--- Also used for Create_TSD, Destroy_TSD, Get_Current_Excep
+-- These are procedure pointers to non-tasking routines that use task
+-- specific data. In the absence of tasking, these routines refer to global
+-- data. In the presense of tasking, they must be replaced with pointers to
+-- task-specific versions. Also used for Create_TSD, Destroy_TSD,
+-- Get_Current_Excep
with System.Tasking.Initialization;
-- Used for Remove_From_All_Tasks_List
-- Initialize_Attributes_Link
pragma Elaborate_All (System.Tasking.Initialization);
--- This insures that tasking is initialized if any tasks are created.
+-- This insures that tasking is initialized if any tasks are created
with System.Tasking.Utilities;
-- Used for Make_Passive
-- Used for System.Finalization_Implementation.Finalize_Global_List
with System.Secondary_Stack;
--- used for SS_Init
+-- Used for SS_Init
with System.Storage_Elements;
--- used for Storage_Array
+-- Used for Storage_Array
with System.Restrictions;
--- used for Abort_Allowed
+-- Used for Abort_Allowed
with System.Standard_Library;
--- used for Exception_Trace
+-- Used for Exception_Trace
with System.Traces.Tasking;
--- used for Send_Trace_Info
+-- Used for Send_Trace_Info
with Unchecked_Deallocation;
--- To recover from failure of ATCB initialization.
+-- To recover from failure of ATCB initialization
package body System.Tasking.Stages is
Self_ID.Callable := False;
- -- Exit level 2 master, for normal tasks in library-level packages.
+ -- Exit level 2 master, for normal tasks in library-level packages
Complete_Master;
- -- Force termination of "independent" library-level server tasks.
+ -- Force termination of "independent" library-level server tasks
Lock_RTS;
-- clean ups associated with the exception handler that need to
-- access task specific data.
- -- Defer abortion so that this task can't be aborted while exiting
+ -- Defer abort so that this task can't be aborted while exiting
when Standard'Abort_Signal =>
Initialization.Defer_Abort_Nestable (Self_ID);
-- The activator raises a Tasking_Error if any task it is activating
-- is completed before the activation is done. However, if the reason
- -- for the task completion is an abortion, we do not raise an exception.
+ -- for the task completion is an abort, we do not raise an exception.
-- See RM 9.2(5).
if not Self_ID.Callable and then Self_ID.Pending_ATC_Level /= 0 then
pragma Assert (Self_ID.Common.Wait_Count = 0);
- -- Force any remaining dependents to terminate, by aborting them.
+ -- Force any remaining dependents to terminate by aborting them
if not Single_Lock then
Lock_RTS;
Unlock (Self_ID);
end if;
- -- We don't wake up for abortion here. We are already terminating
- -- just as fast as we can, so there is no point.
+ -- We don't wake up for abort here. We are already terminating just as
+ -- fast as we can, so there is no point.
-- Remove terminated tasks from the list of Self_ID's dependents, but
-- don't free their ATCBs yet, because of lock order restrictions,
-- Package elaboration code
begin
- -- Establish the Adafinal softlink.
+ -- Establish the Adafinal softlink
-- This is not done inside the central RTS initialization routine
-- to avoid with-ing this package from System.Tasking.Initialization.
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- activate_tasks (_chain'unchecked_access);
procedure Abort_Tasks (Tasks : Task_List);
- -- Compiler interface only. Do not call from within the RTS.
- -- Initiate abortion, however, the actual abortion is done by abortee by
- -- means of Abort_Handler and Abort_Undefer
+ -- Compiler interface only. Do not call from within the RTS. Initiate
+ -- abort, however, the actual abort is done by abortee by means of
+ -- Abort_Handler and Abort_Undefer
--
-- source code:
-- Abort T1, T2;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- the environment task (because every independent task depends on it),
-- this counter is protected by the environment task's lock.
- ------------------------------------
- -- Task Abortion related routines --
- ------------------------------------
+ ---------------------------------
+ -- Task Abort Related Routines --
+ ---------------------------------
procedure Cancel_Queued_Entry_Calls (T : Task_Id);
-- Cancel any entry calls queued on target task.
-- (3) always aborts whole task
procedure Abort_Tasks (Tasks : Task_List);
- -- Abort_Tasks is called to initiate abortion, however, the actual
- -- abortion is done by abortee by means of Abort_Handler
+ -- Abort_Tasks is called to initiate abort, however, the actual
+ -- aborti is done by aborted task by means of Abort_Handler
procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean);
- -- Update counts to indicate current task is either terminated
- -- or accepting on a terminate alternative.
- -- Call holding no locks except Global_Task_Lock when calling from
- -- Terminate_Task, and RTS_Lock when Single_Lock is True.
+ -- Update counts to indicate current task is either terminated or
+ -- accepting on a terminate alternative. Call holding no locks except
+ -- Global_Task_Lock when calling from Terminate_Task, and RTS_Lock when
+ -- Single_Lock is True.
end System.Tasking.Utilities;
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2004, Ada Core Technologies --
+-- Copyright (C) 1995-2005, Ada Core Technologies --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This package provides support for the body of Ada.Task_Attributes.
+-- This package provides support for the body of Ada.Task_Attributes
with Ada.Finalization;
--- used for Limited_Controlled
+-- Used for Limited_Controlled
with System.Storage_Elements;
--- used for Integer_Address
+-- Used for Integer_Address
package System.Tasking.Task_Attributes is
function To_Access_Node is new Unchecked_Conversion
(Access_Address, Access_Node);
- -- Used to fetch pointer to indirect attribute list. Declaration is
- -- in spec to avoid any problems with aliasing assumptions.
+ -- Used to fetch pointer to indirect attribute list. Declaration is in
+ -- spec to avoid any problems with aliasing assumptions.
type Dummy_Wrapper;
type Access_Dummy_Wrapper is access all Dummy_Wrapper;
-- of type Wrapper, no Dummy_Wrapper objects are ever created.
type Deallocator is access procedure (P : in out Access_Node);
- -- Called to deallocate an Wrapper. P is a pointer to a Node within.
+ -- Called to deallocate an Wrapper. P is a pointer to a Node within
type Instance;
Initial_Value : aliased System.Storage_Elements.Integer_Address;
Index : Direct_Index;
- -- The index of the TCB location used by this instantiation,
- -- if it is stored in the TCB, otherwise zero.
+ -- The index of the TCB location used by this instantiation, if it is
+ -- stored in the TCB, otherwise zero.
Next : Access_Instance;
- -- Next instance in All_Attributes list.
+ -- Next instance in All_Attributes list
end record;
procedure Finalize (X : in out Instance);
Next : Access_Node;
end record;
- -- The following type is a stand-in for the actual
- -- wrapper type, which is different for each instantiation
- -- of Ada.Task_Attributes.
+ -- The following type is a stand-in for the actual wrapper type, which is
+ -- different for each instantiation of Ada.Task_Attributes.
type Dummy_Wrapper is record
- Noed : aliased Node;
+ Dummy_Node : aliased Node;
Value : aliased Attribute;
-- The generic formal type, may be controlled
-- Ensure that the designated object is always strictly enough aligned.
In_Use : Direct_Index_Vector := 0;
- -- is True for direct indices that are already used.
+ -- Set True for direct indices that are already used (True??? type???)
All_Attributes : Access_Instance;
- -- A linked list of all indirectly access attributes,
- -- which includes all those that require finalization.
+ -- A linked list of all indirectly access attributes, which includes all
+ -- those that require finalization.
procedure Initialize_Attributes (T : Task_Id);
- -- Initialize all attributes created via Ada.Task_Attributes for T.
- -- This must be called by the creator of the task, inside Create_Task,
- -- via soft-link Initialize_Attributes_Link. On entry, abortion must
- -- be deferred and the caller must hold no locks
+ -- Initialize all attributes created via Ada.Task_Attributes for T. This
+ -- must be called by the creator of the task, inside Create_Task, via
+ -- soft-link Initialize_Attributes_Link. On entry, abort must be deferred
+ -- and the caller must hold no locks
procedure Finalize_Attributes (T : Task_Id);
-- Finalize all attributes created via Ada.Task_Attributes for T.
-- This is to be called by the task after it is marked as terminated
-- (and before it actually dies), inside Vulnerable_Free_Task, via the
- -- soft-link Finalize_Attributes_Link. On entry, abortion must be deferred
+ -- soft-link Finalize_Attributes_Link. On entry, abort must be deferred
-- and T.L must be write-locked.
end System.Tasking.Task_Attributes;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This package contains all the simple primitives related to
--- Protected_Objects with entries (i.e init, lock, unlock).
+-- This package contains all the simple primitives related to protected
+-- objects with entries (i.e init, lock, unlock).
-- The handling of protected objects with no entries is done in
-- System.Tasking.Protected_Objects, the complex routines for protected
-- objects with entries in System.Tasking.Protected_Objects.Operations.
+
-- The split between Entries and Operations is needed to break circular
-- dependencies inside the run time.
--- Note: the compiler generates direct calls to this interface, via Rtsfind.
+-- Note: the compiler generates direct calls to this interface, via Rtsfind
with Ada.Exceptions;
--- used for Exception_Occurrence_Access
+-- Used for Exception_Occurrence_Access
-- Raise_Exception
with System.Task_Primitives.Operations;
--- used for Initialize_Lock
+-- Used for Initialize_Lock
-- Write_Lock
-- Unlock
-- Get_Priority
-- Wakeup
with System.Tasking.Initialization;
--- used for Defer_Abort,
+-- Used for Defer_Abort,
-- Undefer_Abort,
-- Change_Base_Priority
pragma Elaborate_All (System.Tasking.Initialization);
--- this insures that tasking is initialized if any protected objects are
+-- This insures that tasking is initialized if any protected objects are
-- created.
with System.Parameters;
--- used for Single_Lock
+-- Used for Single_Lock
package body System.Tasking.Protected_Objects.Entries is
end if;
if Ceiling_Violation then
- -- Dip our own priority down to ceiling of lock.
- -- See similar code in Tasking.Entry_Calls.Lock_Server.
+
+ -- Dip our own priority down to ceiling of lock. See similar code in
+ -- Tasking.Entry_Calls.Lock_Server.
STPO.Write_Lock (Self_ID);
Old_Base_Priority := Self_ID.Common.Base_Priority;
Object.Pending_Action := True;
end if;
- -- Send program_error to all tasks still queued on this object.
+ -- Send program_error to all tasks still queued on this object
for E in Object.Entry_Queues'Range loop
Entry_Call := Object.Entry_Queues (E).Head;
(Program_Error'Identity, "Protected Object is finalized");
end if;
- -- If pragma Detect_Blocking is active then Program_Error must
- -- be raised if this potentially blocking operation is called from
- -- a protected action, and the protected object nesting level
- -- must be increased.
+ -- If pragma Detect_Blocking is active then Program_Error must be
+ -- raised if this potentially blocking operation is called from a
+ -- protected action, and the protected object nesting level must be
+ -- increased.
if Detect_Blocking then
declare
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
else
- -- We are entering in a protected action, so that we
- -- increase the protected object nesting level.
+ -- We are entering in a protected action, so that we increase
+ -- the protected object nesting level.
Self_Id.Common.Protected_Action_Nesting :=
Self_Id.Common.Protected_Action_Nesting + 1;
end;
end if;
- -- The lock is made without defering abortion.
+ -- The lock is made without defering abort
- -- Therefore the abortion has to be deferred before calling this
- -- routine. This means that the compiler has to generate a Defer_Abort
- -- call before the call to Lock.
+ -- Therefore the abort has to be deferred before calling this routine.
+ -- This means that the compiler has to generate a Defer_Abort call
+ -- before the call to Lock.
- -- The caller is responsible for undeferring abortion, and compiler
+ -- The caller is responsible for undeferring abort, and compiler
-- generated calls must be protected with cleanup handlers to ensure
- -- that abortion is undeferred in all cases.
+ -- that abort is undeferred in all cases.
pragma Assert (STPO.Self.Deferral_Level > 0);
Write_Lock (Object.L'Access, Ceiling_Violation);
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
else
- -- We are entering in a protected action, so that we
- -- increase the protected object nesting level.
+ -- We are entering in a protected action, so that we increase
+ -- the protected object nesting level.
Self_Id.Common.Protected_Action_Nesting :=
Self_Id.Common.Protected_Action_Nesting + 1;
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
--- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . --
--- O P E R A T I O N S --
+-- SYSTEM.TASKING.PROTECTED_OBJECTS.OPERATIONS --
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- --
------------------------------------------------------------------------------
--- This package contains all the extended primitives related to
--- Protected_Objects with entries.
+-- This package contains all the extended primitives related to protected
+-- objects with entries.
+
-- The handling of protected objects with no entries is done in
-- System.Tasking.Protected_Objects, the simple routines for protected
--- objects with entries in System.Tasking.Protected_Objects.Entries.
--- The split between Entries and Operations is needed to break circular
+-- objects with entries in System.Tasking.Protected_Objects.Entries. The
+-- split between Entries and Operations is needed to break circular
-- dependencies inside the run time.
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes.
with Ada.Exceptions;
--- used for Exception_Id
+-- Used for Exception_Id
with System.Tasking.Protected_Objects.Entries;
-- barriers, so this routine keeps checking barriers until all of
-- them are closed.
--
- -- This must be called with abortion deferred and with the corresponding
+ -- This must be called with abort deferred and with the corresponding
-- object locked.
--
-- If Unlock_Object is set True, then Object is unlocked on return,
(Object : Entries.Protection_Entries'Class;
E : Protected_Entry_Index)
return Natural;
- -- Return the number of entry calls to E on Object.
+ -- Return the number of entry calls to E on Object
function Protected_Entry_Caller
(Object : Entries.Protection_Entries'Class) return Task_Id;
-- being handled. This will only work if called from within an entry
-- body, as required by the LRM (C.7.1(14)).
- -- For internal use only:
+ -- For internal use only
procedure PO_Do_Or_Queue
(Self_ID : Task_Id;
Entry_Call : Entry_Call_Link;
With_Abort : Boolean);
-- This procedure either executes or queues an entry call, depending
- -- on the status of the corresponding barrier. It assumes that abortion
+ -- on the status of the corresponding barrier. It assumes that abort
-- is deferred and that the specified object is locked.
private
pragma Volatile (Communication_Block);
-- ?????
- -- The Communication_Block seems to be a relic.
- -- At the moment, the compiler seems to be generating
- -- unnecessary conditional code based on this block.
- -- See the code generated for async. select with task entry
+ -- The Communication_Block seems to be a relic. At the moment, the
+ -- compiler seems to be generating unnecessary conditional code based on
+ -- this block. See the code generated for async. select with task entry
-- call for another way of solving this.
end System.Tasking.Protected_Objects.Operations;
-------------------------------------------------------------------------------\r
--- --\r
--- GNAT COMPILER COMPONENTS --\r
--- --\r
--- S N A M E S --\r
--- --\r
--- B o d y --\r
--- --\r
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --\r
--- --\r
--- GNAT is free software; you can redistribute it and/or modify it under --\r
--- terms of the GNU General Public License as published by the Free Soft- --\r
--- ware Foundation; either version 2, or (at your option) any later ver- --\r
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --\r
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --\r
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --\r
--- for more details. You should have received a copy of the GNU General --\r
--- Public License distributed with GNAT; see file COPYING. If not, write --\r
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --\r
--- MA 02111-1307, USA. --\r
--- --\r
--- As a special exception, if other files instantiate generics from this --\r
--- unit, or you link this unit with other files to produce an executable, --\r
--- this unit does not by itself cause the resulting executable to be --\r
--- covered by the GNU General Public License. This exception does not --\r
--- however invalidate any other reasons why the executable file might be --\r
--- covered by the GNU Public License. --\r
--- --\r
--- GNAT was originally developed by the GNAT team at New York University. --\r
--- Extensive contributions were provided by Ada Core Technologies Inc. --\r
--- --\r
-------------------------------------------------------------------------------\r
-\r
-with Namet; use Namet;\r
-with Table;\r
-\r
-package body Snames is\r
-\r
- -- Table used to record convention identifiers\r
-\r
- type Convention_Id_Entry is record\r
- Name : Name_Id;\r
- Convention : Convention_Id;\r
- end record;\r
-\r
- package Convention_Identifiers is new Table.Table (\r
- Table_Component_Type => Convention_Id_Entry,\r
- Table_Index_Type => Int,\r
- Table_Low_Bound => 1,\r
- Table_Initial => 50,\r
- Table_Increment => 200,\r
- Table_Name => "Name_Convention_Identifiers");\r
-\r
- -- Table of names to be set by Initialize. Each name is terminated by a\r
- -- single #, and the end of the list is marked by a null entry, i.e. by\r
- -- two # marks in succession. Note that the table does not include the\r
- -- entries for a-z, since these are initialized by Namet itself.\r
-\r
- Preset_Names : constant String :=\r
- "_parent#" &\r
- "_tag#" &\r
- "off#" &\r
- "space#" &\r
- "time#" &\r
- "_abort_signal#" &\r
- "_alignment#" &\r
- "_assign#" &\r
- "_atcb#" &\r
- "_chain#" &\r
- "_clean#" &\r
- "_controller#" &\r
- "_entry_bodies#" &\r
- "_expunge#" &\r
- "_final_list#" &\r
- "_idepth#" &\r
- "_init#" &\r
- "_local_final_list#" &\r
- "_master#" &\r
- "_object#" &\r
- "_priority#" &\r
- "_process_atsd#" &\r
- "_secondary_stack#" &\r
- "_service#" &\r
- "_size#" &\r
- "_stack#" &\r
- "_tags#" &\r
- "_task#" &\r
- "_task_id#" &\r
- "_task_info#" &\r
- "_task_name#" &\r
- "_trace_sp#" &\r
- "initialize#" &\r
- "adjust#" &\r
- "finalize#" &\r
- "next#" &\r
- "prev#" &\r
- "_typecode#" &\r
- "_from_any#" &\r
- "_to_any#" &\r
- "allocate#" &\r
- "deallocate#" &\r
- "dereference#" &\r
- "decimal_io#" &\r
- "enumeration_io#" &\r
- "fixed_io#" &\r
- "float_io#" &\r
- "integer_io#" &\r
- "modular_io#" &\r
- "const#" &\r
- "<error>#" &\r
- "go#" &\r
- "put#" &\r
- "put_line#" &\r
- "to#" &\r
- "finalization#" &\r
- "finalization_root#" &\r
- "interfaces#" &\r
- "standard#" &\r
- "system#" &\r
- "text_io#" &\r
- "wide_text_io#" &\r
- "wide_wide_text_io#" &\r
- "no_dsa#" &\r
- "garlic_dsa#" &\r
- "polyorb_dsa#" &\r
- "addr#" &\r
- "async#" &\r
- "get_active_partition_id#" &\r
- "get_rci_package_receiver#" &\r
- "get_rci_package_ref#" &\r
- "origin#" &\r
- "params#" &\r
- "partition#" &\r
- "partition_interface#" &\r
- "ras#" &\r
- "call#" &\r
- "rci_name#" &\r
- "receiver#" &\r
- "result#" &\r
- "rpc#" &\r
- "subp_id#" &\r
- "operation#" &\r
- "argument#" &\r
- "arg_modes#" &\r
- "handler#" &\r
- "target#" &\r
- "req#" &\r
- "obj_typecode#" &\r
- "stub#" &\r
- "Oabs#" &\r
- "Oand#" &\r
- "Omod#" &\r
- "Onot#" &\r
- "Oor#" &\r
- "Orem#" &\r
- "Oxor#" &\r
- "Oeq#" &\r
- "One#" &\r
- "Olt#" &\r
- "Ole#" &\r
- "Ogt#" &\r
- "Oge#" &\r
- "Oadd#" &\r
- "Osubtract#" &\r
- "Oconcat#" &\r
- "Omultiply#" &\r
- "Odivide#" &\r
- "Oexpon#" &\r
- "ada_83#" &\r
- "ada_95#" &\r
- "ada_05#" &\r
- "c_pass_by_copy#" &\r
- "compile_time_warning#" &\r
- "component_alignment#" &\r
- "convention_identifier#" &\r
- "detect_blocking#" &\r
- "discard_names#" &\r
- "elaboration_checks#" &\r
- "eliminate#" &\r
- "explicit_overriding#" &\r
- "extend_system#" &\r
- "extensions_allowed#" &\r
- "external_name_casing#" &\r
- "float_representation#" &\r
- "initialize_scalars#" &\r
- "interrupt_state#" &\r
- "license#" &\r
- "locking_policy#" &\r
- "long_float#" &\r
- "no_run_time#" &\r
- "no_strict_aliasing#" &\r
- "normalize_scalars#" &\r
- "polling#" &\r
- "persistent_data#" &\r
- "persistent_object#" &\r
- "profile#" &\r
- "profile_warnings#" &\r
- "propagate_exceptions#" &\r
- "queuing_policy#" &\r
- "ravenscar#" &\r
- "restricted_run_time#" &\r
- "restrictions#" &\r
- "restriction_warnings#" &\r
- "reviewable#" &\r
- "source_file_name#" &\r
- "source_file_name_project#" &\r
- "style_checks#" &\r
- "suppress#" &\r
- "suppress_exception_locations#" &\r
- "task_dispatching_policy#" &\r
- "universal_data#" &\r
- "unsuppress#" &\r
- "use_vads_size#" &\r
- "validity_checks#" &\r
- "warnings#" &\r
- "abort_defer#" &\r
- "all_calls_remote#" &\r
- "annotate#" &\r
- "assert#" &\r
- "asynchronous#" &\r
- "atomic#" &\r
- "atomic_components#" &\r
- "attach_handler#" &\r
- "comment#" &\r
- "common_object#" &\r
- "complex_representation#" &\r
- "controlled#" &\r
- "convention#" &\r
- "cpp_class#" &\r
- "cpp_constructor#" &\r
- "cpp_virtual#" &\r
- "cpp_vtable#" &\r
- "debug#" &\r
- "elaborate#" &\r
- "elaborate_all#" &\r
- "elaborate_body#" &\r
- "export#" &\r
- "export_exception#" &\r
- "export_function#" &\r
- "export_object#" &\r
- "export_procedure#" &\r
- "export_value#" &\r
- "export_valued_procedure#" &\r
- "external#" &\r
- "finalize_storage_only#" &\r
- "ident#" &\r
- "import#" &\r
- "import_exception#" &\r
- "import_function#" &\r
- "import_object#" &\r
- "import_procedure#" &\r
- "import_valued_procedure#" &\r
- "inline#" &\r
- "inline_always#" &\r
- "inline_generic#" &\r
- "inspection_point#" &\r
- "interface_name#" &\r
- "interrupt_handler#" &\r
- "interrupt_priority#" &\r
- "java_constructor#" &\r
- "java_interface#" &\r
- "keep_names#" &\r
- "link_with#" &\r
- "linker_alias#" &\r
- "linker_options#" &\r
- "linker_section#" &\r
- "list#" &\r
- "machine_attribute#" &\r
- "main#" &\r
- "main_storage#" &\r
- "memory_size#" &\r
- "no_return#" &\r
- "obsolescent#" &\r
- "optimize#" &\r
- "optional_overriding#" &\r
- "pack#" &\r
- "page#" &\r
- "passive#" &\r
- "preelaborate#" &\r
- "priority#" &\r
- "psect_object#" &\r
- "pure#" &\r
- "pure_function#" &\r
- "remote_call_interface#" &\r
- "remote_types#" &\r
- "share_generic#" &\r
- "shared#" &\r
- "shared_passive#" &\r
- "source_reference#" &\r
- "stream_convert#" &\r
- "subtitle#" &\r
- "suppress_all#" &\r
- "suppress_debug_info#" &\r
- "suppress_initialization#" &\r
- "system_name#" &\r
- "task_info#" &\r
- "task_name#" &\r
- "task_storage#" &\r
- "thread_body#" &\r
- "time_slice#" &\r
- "title#" &\r
- "unchecked_union#" &\r
- "unimplemented_unit#" &\r
- "unreferenced#" &\r
- "unreserve_all_interrupts#" &\r
- "volatile#" &\r
- "volatile_components#" &\r
- "weak_external#" &\r
- "ada#" &\r
- "assembler#" &\r
- "cobol#" &\r
- "cpp#" &\r
- "fortran#" &\r
- "intrinsic#" &\r
- "java#" &\r
- "stdcall#" &\r
- "stubbed#" &\r
- "asm#" &\r
- "assembly#" &\r
- "default#" &\r
- "dll#" &\r
- "win32#" &\r
- "as_is#" &\r
- "body_file_name#" &\r
- "boolean_entry_barriers#" &\r
- "casing#" &\r
- "code#" &\r
- "component#" &\r
- "component_size_4#" &\r
- "copy#" &\r
- "d_float#" &\r
- "descriptor#" &\r
- "dot_replacement#" &\r
- "dynamic#" &\r
- "entity#" &\r
- "external_name#" &\r
- "first_optional_parameter#" &\r
- "form#" &\r
- "g_float#" &\r
- "gcc#" &\r
- "gnat#" &\r
- "gpl#" &\r
- "ieee_float#" &\r
- "internal#" &\r
- "link_name#" &\r
- "lowercase#" &\r
- "max_entry_queue_depth#" &\r
- "max_entry_queue_length#" &\r
- "max_size#" &\r
- "mechanism#" &\r
- "mixedcase#" &\r
- "modified_gpl#" &\r
- "name#" &\r
- "nca#" &\r
- "no#" &\r
- "no_dependence#" &\r
- "no_dynamic_attachment#" &\r
- "no_dynamic_interrupts#" &\r
- "no_requeue#" &\r
- "no_requeue_statements#" &\r
- "no_task_attributes#" &\r
- "no_task_attributes_package#" &\r
- "on#" &\r
- "parameter_types#" &\r
- "reference#" &\r
- "restricted#" &\r
- "result_mechanism#" &\r
- "result_type#" &\r
- "runtime#" &\r
- "sb#" &\r
- "secondary_stack_size#" &\r
- "section#" &\r
- "semaphore#" &\r
- "simple_barriers#" &\r
- "spec_file_name#" &\r
- "static#" &\r
- "stack_size#" &\r
- "subunit_file_name#" &\r
- "task_stack_size_default#" &\r
- "task_type#" &\r
- "time_slicing_enabled#" &\r
- "top_guard#" &\r
- "uba#" &\r
- "ubs#" &\r
- "ubsb#" &\r
- "unit_name#" &\r
- "unknown#" &\r
- "unrestricted#" &\r
- "uppercase#" &\r
- "user#" &\r
- "vax_float#" &\r
- "vms#" &\r
- "working_storage#" &\r
- "abort_signal#" &\r
- "access#" &\r
- "address#" &\r
- "address_size#" &\r
- "aft#" &\r
- "alignment#" &\r
- "asm_input#" &\r
- "asm_output#" &\r
- "ast_entry#" &\r
- "bit#" &\r
- "bit_order#" &\r
- "bit_position#" &\r
- "body_version#" &\r
- "callable#" &\r
- "caller#" &\r
- "code_address#" &\r
- "component_size#" &\r
- "compose#" &\r
- "constrained#" &\r
- "count#" &\r
- "default_bit_order#" &\r
- "definite#" &\r
- "delta#" &\r
- "denorm#" &\r
- "digits#" &\r
- "elaborated#" &\r
- "emax#" &\r
- "enum_rep#" &\r
- "epsilon#" &\r
- "exponent#" &\r
- "external_tag#" &\r
- "first#" &\r
- "first_bit#" &\r
- "fixed_value#" &\r
- "fore#" &\r
- "has_access_values#" &\r
- "has_discriminants#" &\r
- "identity#" &\r
- "img#" &\r
- "integer_value#" &\r
- "large#" &\r
- "last#" &\r
- "last_bit#" &\r
- "leading_part#" &\r
- "length#" &\r
- "machine_emax#" &\r
- "machine_emin#" &\r
- "machine_mantissa#" &\r
- "machine_overflows#" &\r
- "machine_radix#" &\r
- "machine_rounds#" &\r
- "machine_size#" &\r
- "mantissa#" &\r
- "max_size_in_storage_elements#" &\r
- "maximum_alignment#" &\r
- "mechanism_code#" &\r
- "mod#" &\r
- "model_emin#" &\r
- "model_epsilon#" &\r
- "model_mantissa#" &\r
- "model_small#" &\r
- "modulus#" &\r
- "null_parameter#" &\r
- "object_size#" &\r
- "partition_id#" &\r
- "passed_by_reference#" &\r
- "pool_address#" &\r
- "pos#" &\r
- "position#" &\r
- "range#" &\r
- "range_length#" &\r
- "round#" &\r
- "safe_emax#" &\r
- "safe_first#" &\r
- "safe_large#" &\r
- "safe_last#" &\r
- "safe_small#" &\r
- "scale#" &\r
- "scaling#" &\r
- "signed_zeros#" &\r
- "size#" &\r
- "small#" &\r
- "storage_size#" &\r
- "storage_unit#" &\r
- "stream_size#" &\r
- "tag#" &\r
- "target_name#" &\r
- "terminated#" &\r
- "to_address#" &\r
- "type_class#" &\r
- "uet_address#" &\r
- "unbiased_rounding#" &\r
- "unchecked_access#" &\r
- "unconstrained_array#" &\r
- "universal_literal_string#" &\r
- "unrestricted_access#" &\r
- "vads_size#" &\r
- "val#" &\r
- "valid#" &\r
- "value_size#" &\r
- "version#" &\r
- "wchar_t_size#" &\r
- "wide_wide_width#" &\r
- "wide_width#" &\r
- "width#" &\r
- "word_size#" &\r
- "adjacent#" &\r
- "ceiling#" &\r
- "copy_sign#" &\r
- "floor#" &\r
- "fraction#" &\r
- "image#" &\r
- "input#" &\r
- "machine#" &\r
- "max#" &\r
- "min#" &\r
- "model#" &\r
- "pred#" &\r
- "remainder#" &\r
- "rounding#" &\r
- "succ#" &\r
- "truncation#" &\r
- "value#" &\r
- "wide_image#" &\r
- "wide_wide_image#" &\r
- "wide_value#" &\r
- "wide_wide_value#" &\r
- "output#" &\r
- "read#" &\r
- "write#" &\r
- "elab_body#" &\r
- "elab_spec#" &\r
- "storage_pool#" &\r
- "base#" &\r
- "class#" &\r
- "ceiling_locking#" &\r
- "inheritance_locking#" &\r
- "fifo_queuing#" &\r
- "priority_queuing#" &\r
- "fifo_within_priorities#" &\r
- "access_check#" &\r
- "accessibility_check#" &\r
- "discriminant_check#" &\r
- "division_check#" &\r
- "elaboration_check#" &\r
- "index_check#" &\r
- "length_check#" &\r
- "overflow_check#" &\r
- "range_check#" &\r
- "storage_check#" &\r
- "tag_check#" &\r
- "all_checks#" &\r
- "abort#" &\r
- "abs#" &\r
- "accept#" &\r
- "and#" &\r
- "all#" &\r
- "array#" &\r
- "at#" &\r
- "begin#" &\r
- "body#" &\r
- "case#" &\r
- "constant#" &\r
- "declare#" &\r
- "delay#" &\r
- "do#" &\r
- "else#" &\r
- "elsif#" &\r
- "end#" &\r
- "entry#" &\r
- "exception#" &\r
- "exit#" &\r
- "for#" &\r
- "function#" &\r
- "generic#" &\r
- "goto#" &\r
- "if#" &\r
- "in#" &\r
- "is#" &\r
- "limited#" &\r
- "loop#" &\r
- "new#" &\r
- "not#" &\r
- "null#" &\r
- "of#" &\r
- "or#" &\r
- "others#" &\r
- "out#" &\r
- "package#" &\r
- "pragma#" &\r
- "private#" &\r
- "procedure#" &\r
- "raise#" &\r
- "record#" &\r
- "rem#" &\r
- "renames#" &\r
- "return#" &\r
- "reverse#" &\r
- "select#" &\r
- "separate#" &\r
- "subtype#" &\r
- "task#" &\r
- "terminate#" &\r
- "then#" &\r
- "type#" &\r
- "use#" &\r
- "when#" &\r
- "while#" &\r
- "with#" &\r
- "xor#" &\r
- "divide#" &\r
- "enclosing_entity#" &\r
- "exception_information#" &\r
- "exception_message#" &\r
- "exception_name#" &\r
- "file#" &\r
- "import_address#" &\r
- "import_largest_value#" &\r
- "import_value#" &\r
- "is_negative#" &\r
- "line#" &\r
- "rotate_left#" &\r
- "rotate_right#" &\r
- "shift_left#" &\r
- "shift_right#" &\r
- "shift_right_arithmetic#" &\r
- "source_location#" &\r
- "unchecked_conversion#" &\r
- "unchecked_deallocation#" &\r
- "to_pointer#" &\r
- "abstract#" &\r
- "aliased#" &\r
- "protected#" &\r
- "until#" &\r
- "requeue#" &\r
- "tagged#" &\r
- "raise_exception#" &\r
- "ada_roots#" &\r
- "binder#" &\r
- "binder_driver#" &\r
- "body_suffix#" &\r
- "builder#" &\r
- "compiler#" &\r
- "compiler_driver#" &\r
- "compiler_kind#" &\r
- "compute_dependency#" &\r
- "cross_reference#" &\r
- "default_linker#" &\r
- "default_switches#" &\r
- "dependency_option#" &\r
- "exec_dir#" &\r
- "executable#" &\r
- "executable_suffix#" &\r
- "extends#" &\r
- "externally_built#" &\r
- "finder#" &\r
- "global_configuration_pragmas#" &\r
- "gnatls#" &\r
- "gnatstub#" &\r
- "implementation#" &\r
- "implementation_exceptions#" &\r
- "implementation_suffix#" &\r
- "include_option#" &\r
- "language_processing#" &\r
- "languages#" &\r
- "library_dir#" &\r
- "library_auto_init#" &\r
- "library_gcc#" &\r
- "library_interface#" &\r
- "library_kind#" &\r
- "library_name#" &\r
- "library_options#" &\r
- "library_reference_symbol_file#" &\r
- "library_src_dir#" &\r
- "library_symbol_file#" &\r
- "library_symbol_policy#" &\r
- "library_version#" &\r
- "linker#" &\r
- "local_configuration_pragmas#" &\r
- "locally_removed_files#" &\r
- "metrics#" &\r
- "naming#" &\r
- "object_dir#" &\r
- "pretty_printer#" &\r
- "project#" &\r
- "separate_suffix#" &\r
- "source_dirs#" &\r
- "source_files#" &\r
- "source_list_file#" &\r
- "spec#" &\r
- "spec_suffix#" &\r
- "specification#" &\r
- "specification_exceptions#" &\r
- "specification_suffix#" &\r
- "switches#" &\r
- "unaligned_valid#" &\r
- "interface#" &\r
- "overriding#" &\r
- "synchronized#" &\r
- "#";\r
-\r
- ---------------------\r
- -- Generated Names --\r
- ---------------------\r
-\r
- -- This section lists the various cases of generated names which are\r
- -- built from existing names by adding unique leading and/or trailing\r
- -- upper case letters. In some cases these names are built recursively,\r
- -- in particular names built from types may be built from types which\r
- -- themselves have generated names. In this list, xxx represents an\r
- -- existing name to which identifying letters are prepended or appended,\r
- -- and a trailing n represents a serial number in an external name that\r
- -- has some semantic significance (e.g. the n'th index type of an array).\r
-\r
- -- xxxA access type for formal xxx in entry param record (Exp_Ch9)\r
- -- xxxB tag table for tagged type xxx (Exp_Ch3)\r
- -- xxxB task body procedure for task xxx (Exp_Ch9)\r
- -- xxxD dispatch table for tagged type xxx (Exp_Ch3)\r
- -- xxxD discriminal for discriminant xxx (Sem_Ch3)\r
- -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3)\r
- -- xxxE elaboration boolean flag for task xxx (Exp_Ch9)\r
- -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3)\r
- -- xxxE parameters for accept body for entry xxx (Exp_Ch9)\r
- -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3)\r
- -- xxxJ tag table type index for tagged type xxx (Exp_Ch3)\r
- -- xxxM master Id value for access type xxx (Exp_Ch3)\r
- -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3)\r
- -- xxxP parameter record type for entry xxx (Exp_Ch9)\r
- -- xxxPA access to parameter record type for entry xxx (Exp_Ch9)\r
- -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3)\r
- -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3)\r
- -- xxxT tag table type for tagged type xxx (Exp_Ch3)\r
- -- xxxT literal table for enumeration type xxx (Sem_Ch3)\r
- -- xxxV type for task value record for task xxx (Exp_Ch9)\r
- -- xxxX entry index constant (Exp_Ch9)\r
- -- xxxY dispatch table type for tagged type xxx (Exp_Ch3)\r
- -- xxxZ size variable for task xxx (Exp_Ch9)\r
-\r
- -- TSS names\r
-\r
- -- xxxDA deep adjust routine for type xxx (Exp_TSS)\r
- -- xxxDF deep finalize routine for type xxx (Exp_TSS)\r
- -- xxxDI deep initialize routine for type xxx (Exp_TSS)\r
- -- xxxEQ composite equality routine for record type xxx (Exp_TSS)\r
- -- xxxIP initialization procedure for type xxx (Exp_TSS)\r
- -- xxxRA RAs type access routine for type xxx (Exp_TSS)\r
- -- xxxRD RAs type dereference routine for type xxx (Exp_TSS)\r
- -- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS)\r
- -- xxxSA array/slice assignment for controlled comp. arrays (Exp_TSS)\r
- -- xxxSI stream input attribute subprogram for type xxx (Exp_TSS)\r
- -- xxxSO stream output attribute subprogram for type xxx (Exp_TSS)\r
- -- xxxSR stream read attribute subprogram for type xxx (Exp_TSS)\r
- -- xxxSW stream write attribute subprogram for type xxx (Exp_TSS)\r
-\r
- -- Implicit type names\r
-\r
- -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3)\r
-\r
- -- (Note: this list is not complete or accurate ???)\r
-\r
- ----------------------\r
- -- Get_Attribute_Id --\r
- ----------------------\r
-\r
- function Get_Attribute_Id (N : Name_Id) return Attribute_Id is\r
- begin\r
- return Attribute_Id'Val (N - First_Attribute_Name);\r
- end Get_Attribute_Id;\r
-\r
- ------------------\r
- -- Get_Check_Id --\r
- ------------------\r
-\r
- function Get_Check_Id (N : Name_Id) return Check_Id is\r
- begin\r
- return Check_Id'Val (N - First_Check_Name);\r
- end Get_Check_Id;\r
-\r
- -----------------------\r
- -- Get_Convention_Id --\r
- -----------------------\r
-\r
- function Get_Convention_Id (N : Name_Id) return Convention_Id is\r
- begin\r
- case N is\r
- when Name_Ada => return Convention_Ada;\r
- when Name_Assembler => return Convention_Assembler;\r
- when Name_C => return Convention_C;\r
- when Name_COBOL => return Convention_COBOL;\r
- when Name_CPP => return Convention_CPP;\r
- when Name_Fortran => return Convention_Fortran;\r
- when Name_Intrinsic => return Convention_Intrinsic;\r
- when Name_Java => return Convention_Java;\r
- when Name_Stdcall => return Convention_Stdcall;\r
- when Name_Stubbed => return Convention_Stubbed;\r
-\r
- -- If no direct match, then we must have a convention\r
- -- identifier pragma that has specified this name.\r
-\r
- when others =>\r
- for J in 1 .. Convention_Identifiers.Last loop\r
- if N = Convention_Identifiers.Table (J).Name then\r
- return Convention_Identifiers.Table (J).Convention;\r
- end if;\r
- end loop;\r
-\r
- raise Program_Error;\r
- end case;\r
- end Get_Convention_Id;\r
-\r
- ---------------------------\r
- -- Get_Locking_Policy_Id --\r
- ---------------------------\r
-\r
- function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is\r
- begin\r
- return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);\r
- end Get_Locking_Policy_Id;\r
-\r
- -------------------\r
- -- Get_Pragma_Id --\r
- -------------------\r
-\r
- function Get_Pragma_Id (N : Name_Id) return Pragma_Id is\r
- begin\r
- if N = Name_AST_Entry then\r
- return Pragma_AST_Entry;\r
- elsif N = Name_Interface then\r
- return Pragma_Interface;\r
- elsif N = Name_Storage_Size then\r
- return Pragma_Storage_Size;\r
- elsif N = Name_Storage_Unit then\r
- return Pragma_Storage_Unit;\r
- elsif N not in First_Pragma_Name .. Last_Pragma_Name then\r
- return Unknown_Pragma;\r
- else\r
- return Pragma_Id'Val (N - First_Pragma_Name);\r
- end if;\r
- end Get_Pragma_Id;\r
-\r
- ---------------------------\r
- -- Get_Queuing_Policy_Id --\r
- ---------------------------\r
-\r
- function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is\r
- begin\r
- return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);\r
- end Get_Queuing_Policy_Id;\r
-\r
- ------------------------------------\r
- -- Get_Task_Dispatching_Policy_Id --\r
- ------------------------------------\r
-\r
- function Get_Task_Dispatching_Policy_Id (N : Name_Id)\r
- return Task_Dispatching_Policy_Id is\r
- begin\r
- return Task_Dispatching_Policy_Id'Val\r
- (N - First_Task_Dispatching_Policy_Name);\r
- end Get_Task_Dispatching_Policy_Id;\r
-\r
- ----------------\r
- -- Initialize --\r
- ----------------\r
-\r
- procedure Initialize is\r
- P_Index : Natural;\r
- Discard_Name : Name_Id;\r
-\r
- begin\r
- P_Index := Preset_Names'First;\r
-\r
- loop\r
- Name_Len := 0;\r
-\r
- while Preset_Names (P_Index) /= '#' loop\r
- Name_Len := Name_Len + 1;\r
- Name_Buffer (Name_Len) := Preset_Names (P_Index);\r
- P_Index := P_Index + 1;\r
- end loop;\r
-\r
- -- We do the Name_Find call to enter the name into the table, but\r
- -- we don't need to do anything with the result, since we already\r
- -- initialized all the preset names to have the right value (we\r
- -- are depending on the order of the names and Preset_Names).\r
-\r
- Discard_Name := Name_Find;\r
- P_Index := P_Index + 1;\r
- exit when Preset_Names (P_Index) = '#';\r
- end loop;\r
-\r
- -- Make sure that number of names in standard table is correct. If\r
- -- this check fails, run utility program XSNAMES to construct a new\r
- -- properly matching version of the body.\r
-\r
- pragma Assert (Discard_Name = Last_Predefined_Name);\r
-\r
- -- Initialize the convention identifiers table with the standard\r
- -- set of synonyms that we recognize for conventions.\r
-\r
- Convention_Identifiers.Init;\r
-\r
- Convention_Identifiers.Append ((Name_Asm, Convention_Assembler));\r
- Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));\r
-\r
- Convention_Identifiers.Append ((Name_Default, Convention_C));\r
- Convention_Identifiers.Append ((Name_External, Convention_C));\r
-\r
- Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall));\r
- Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall));\r
- end Initialize;\r
-\r
- -----------------------\r
- -- Is_Attribute_Name --\r
- -----------------------\r
-\r
- function Is_Attribute_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Attribute_Name .. Last_Attribute_Name;\r
- end Is_Attribute_Name;\r
-\r
- -------------------\r
- -- Is_Check_Name --\r
- -------------------\r
-\r
- function Is_Check_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Check_Name .. Last_Check_Name;\r
- end Is_Check_Name;\r
-\r
- ------------------------\r
- -- Is_Convention_Name --\r
- ------------------------\r
-\r
- function Is_Convention_Name (N : Name_Id) return Boolean is\r
- begin\r
- -- Check if this is one of the standard conventions\r
-\r
- if N in First_Convention_Name .. Last_Convention_Name\r
- or else N = Name_C\r
- then\r
- return True;\r
-\r
- -- Otherwise check if it is in convention identifier table\r
-\r
- else\r
- for J in 1 .. Convention_Identifiers.Last loop\r
- if N = Convention_Identifiers.Table (J).Name then\r
- return True;\r
- end if;\r
- end loop;\r
-\r
- return False;\r
- end if;\r
- end Is_Convention_Name;\r
-\r
- ------------------------------\r
- -- Is_Entity_Attribute_Name --\r
- ------------------------------\r
-\r
- function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;\r
- end Is_Entity_Attribute_Name;\r
-\r
- --------------------------------\r
- -- Is_Function_Attribute_Name --\r
- --------------------------------\r
-\r
- function Is_Function_Attribute_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in\r
- First_Renamable_Function_Attribute ..\r
- Last_Renamable_Function_Attribute;\r
- end Is_Function_Attribute_Name;\r
-\r
- ----------------------------\r
- -- Is_Locking_Policy_Name --\r
- ----------------------------\r
-\r
- function Is_Locking_Policy_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;\r
- end Is_Locking_Policy_Name;\r
-\r
- -----------------------------\r
- -- Is_Operator_Symbol_Name --\r
- -----------------------------\r
-\r
- function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Operator_Name .. Last_Operator_Name;\r
- end Is_Operator_Symbol_Name;\r
-\r
- --------------------\r
- -- Is_Pragma_Name --\r
- --------------------\r
-\r
- function Is_Pragma_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Pragma_Name .. Last_Pragma_Name\r
- or else N = Name_AST_Entry\r
- or else N = Name_Interface\r
- or else N = Name_Storage_Size\r
- or else N = Name_Storage_Unit;\r
- end Is_Pragma_Name;\r
-\r
- ---------------------------------\r
- -- Is_Procedure_Attribute_Name --\r
- ---------------------------------\r
-\r
- function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Procedure_Attribute .. Last_Procedure_Attribute;\r
- end Is_Procedure_Attribute_Name;\r
-\r
- ----------------------------\r
- -- Is_Queuing_Policy_Name --\r
- ----------------------------\r
-\r
- function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;\r
- end Is_Queuing_Policy_Name;\r
-\r
- -------------------------------------\r
- -- Is_Task_Dispatching_Policy_Name --\r
- -------------------------------------\r
-\r
- function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Task_Dispatching_Policy_Name ..\r
- Last_Task_Dispatching_Policy_Name;\r
- end Is_Task_Dispatching_Policy_Name;\r
-\r
- ----------------------------\r
- -- Is_Type_Attribute_Name --\r
- ----------------------------\r
-\r
- function Is_Type_Attribute_Name (N : Name_Id) return Boolean is\r
- begin\r
- return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;\r
- end Is_Type_Attribute_Name;\r
-\r
- ----------------------------------\r
- -- Record_Convention_Identifier --\r
- ----------------------------------\r
-\r
- procedure Record_Convention_Identifier\r
- (Id : Name_Id;\r
- Convention : Convention_Id)\r
- is\r
- begin\r
- Convention_Identifiers.Append ((Id, Convention));\r
- end Record_Convention_Identifier;\r
-\r
-end Snames;\r
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S N A M E S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2005, 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- --
+-- 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 Namet; use Namet;
+with Table;
+
+package body Snames is
+
+ -- Table used to record convention identifiers
+
+ type Convention_Id_Entry is record
+ Name : Name_Id;
+ Convention : Convention_Id;
+ end record;
+
+ package Convention_Identifiers is new Table.Table (
+ Table_Component_Type => Convention_Id_Entry,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => 50,
+ Table_Increment => 200,
+ Table_Name => "Name_Convention_Identifiers");
+
+ -- Table of names to be set by Initialize. Each name is terminated by a
+ -- single #, and the end of the list is marked by a null entry, i.e. by
+ -- two # marks in succession. Note that the table does not include the
+ -- entries for a-z, since these are initialized by Namet itself.
+
+ Preset_Names : constant String :=
+ "_parent#" &
+ "_tag#" &
+ "off#" &
+ "space#" &
+ "time#" &
+ "_abort_signal#" &
+ "_alignment#" &
+ "_assign#" &
+ "_atcb#" &
+ "_chain#" &
+ "_clean#" &
+ "_controller#" &
+ "_entry_bodies#" &
+ "_expunge#" &
+ "_final_list#" &
+ "_idepth#" &
+ "_init#" &
+ "_local_final_list#" &
+ "_master#" &
+ "_object#" &
+ "_priority#" &
+ "_process_atsd#" &
+ "_secondary_stack#" &
+ "_service#" &
+ "_size#" &
+ "_stack#" &
+ "_tags#" &
+ "_task#" &
+ "_task_id#" &
+ "_task_info#" &
+ "_task_name#" &
+ "_trace_sp#" &
+ "initialize#" &
+ "adjust#" &
+ "finalize#" &
+ "next#" &
+ "prev#" &
+ "_typecode#" &
+ "_from_any#" &
+ "_to_any#" &
+ "allocate#" &
+ "deallocate#" &
+ "dereference#" &
+ "decimal_io#" &
+ "enumeration_io#" &
+ "fixed_io#" &
+ "float_io#" &
+ "integer_io#" &
+ "modular_io#" &
+ "const#" &
+ "<error>#" &
+ "go#" &
+ "put#" &
+ "put_line#" &
+ "to#" &
+ "finalization#" &
+ "finalization_root#" &
+ "interfaces#" &
+ "standard#" &
+ "system#" &
+ "text_io#" &
+ "wide_text_io#" &
+ "wide_wide_text_io#" &
+ "no_dsa#" &
+ "garlic_dsa#" &
+ "polyorb_dsa#" &
+ "addr#" &
+ "async#" &
+ "get_active_partition_id#" &
+ "get_rci_package_receiver#" &
+ "get_rci_package_ref#" &
+ "origin#" &
+ "params#" &
+ "partition#" &
+ "partition_interface#" &
+ "ras#" &
+ "call#" &
+ "rci_name#" &
+ "receiver#" &
+ "result#" &
+ "rpc#" &
+ "subp_id#" &
+ "operation#" &
+ "argument#" &
+ "arg_modes#" &
+ "handler#" &
+ "target#" &
+ "req#" &
+ "obj_typecode#" &
+ "stub#" &
+ "Oabs#" &
+ "Oand#" &
+ "Omod#" &
+ "Onot#" &
+ "Oor#" &
+ "Orem#" &
+ "Oxor#" &
+ "Oeq#" &
+ "One#" &
+ "Olt#" &
+ "Ole#" &
+ "Ogt#" &
+ "Oge#" &
+ "Oadd#" &
+ "Osubtract#" &
+ "Oconcat#" &
+ "Omultiply#" &
+ "Odivide#" &
+ "Oexpon#" &
+ "ada_83#" &
+ "ada_95#" &
+ "ada_05#" &
+ "c_pass_by_copy#" &
+ "compile_time_warning#" &
+ "component_alignment#" &
+ "convention_identifier#" &
+ "detect_blocking#" &
+ "discard_names#" &
+ "elaboration_checks#" &
+ "eliminate#" &
+ "explicit_overriding#" &
+ "extend_system#" &
+ "extensions_allowed#" &
+ "external_name_casing#" &
+ "float_representation#" &
+ "initialize_scalars#" &
+ "interrupt_state#" &
+ "license#" &
+ "locking_policy#" &
+ "long_float#" &
+ "no_run_time#" &
+ "no_strict_aliasing#" &
+ "normalize_scalars#" &
+ "polling#" &
+ "persistent_data#" &
+ "persistent_object#" &
+ "profile#" &
+ "profile_warnings#" &
+ "propagate_exceptions#" &
+ "queuing_policy#" &
+ "ravenscar#" &
+ "restricted_run_time#" &
+ "restrictions#" &
+ "restriction_warnings#" &
+ "reviewable#" &
+ "source_file_name#" &
+ "source_file_name_project#" &
+ "style_checks#" &
+ "suppress#" &
+ "suppress_exception_locations#" &
+ "task_dispatching_policy#" &
+ "universal_data#" &
+ "unsuppress#" &
+ "use_vads_size#" &
+ "validity_checks#" &
+ "warnings#" &
+ "abort_defer#" &
+ "all_calls_remote#" &
+ "annotate#" &
+ "assert#" &
+ "asynchronous#" &
+ "atomic#" &
+ "atomic_components#" &
+ "attach_handler#" &
+ "comment#" &
+ "common_object#" &
+ "complex_representation#" &
+ "controlled#" &
+ "convention#" &
+ "cpp_class#" &
+ "cpp_constructor#" &
+ "cpp_virtual#" &
+ "cpp_vtable#" &
+ "debug#" &
+ "elaborate#" &
+ "elaborate_all#" &
+ "elaborate_body#" &
+ "export#" &
+ "export_exception#" &
+ "export_function#" &
+ "export_object#" &
+ "export_procedure#" &
+ "export_value#" &
+ "export_valued_procedure#" &
+ "external#" &
+ "finalize_storage_only#" &
+ "ident#" &
+ "import#" &
+ "import_exception#" &
+ "import_function#" &
+ "import_object#" &
+ "import_procedure#" &
+ "import_valued_procedure#" &
+ "inline#" &
+ "inline_always#" &
+ "inline_generic#" &
+ "inspection_point#" &
+ "interface_name#" &
+ "interrupt_handler#" &
+ "interrupt_priority#" &
+ "java_constructor#" &
+ "java_interface#" &
+ "keep_names#" &
+ "link_with#" &
+ "linker_alias#" &
+ "linker_options#" &
+ "linker_section#" &
+ "list#" &
+ "machine_attribute#" &
+ "main#" &
+ "main_storage#" &
+ "memory_size#" &
+ "no_return#" &
+ "obsolescent#" &
+ "optimize#" &
+ "optional_overriding#" &
+ "pack#" &
+ "page#" &
+ "passive#" &
+ "preelaborate#" &
+ "priority#" &
+ "psect_object#" &
+ "pure#" &
+ "pure_function#" &
+ "remote_call_interface#" &
+ "remote_types#" &
+ "share_generic#" &
+ "shared#" &
+ "shared_passive#" &
+ "source_reference#" &
+ "stream_convert#" &
+ "subtitle#" &
+ "suppress_all#" &
+ "suppress_debug_info#" &
+ "suppress_initialization#" &
+ "system_name#" &
+ "task_info#" &
+ "task_name#" &
+ "task_storage#" &
+ "thread_body#" &
+ "time_slice#" &
+ "title#" &
+ "unchecked_union#" &
+ "unimplemented_unit#" &
+ "unreferenced#" &
+ "unreserve_all_interrupts#" &
+ "volatile#" &
+ "volatile_components#" &
+ "weak_external#" &
+ "ada#" &
+ "assembler#" &
+ "cobol#" &
+ "cpp#" &
+ "fortran#" &
+ "intrinsic#" &
+ "java#" &
+ "stdcall#" &
+ "stubbed#" &
+ "asm#" &
+ "assembly#" &
+ "default#" &
+ "dll#" &
+ "win32#" &
+ "as_is#" &
+ "body_file_name#" &
+ "boolean_entry_barriers#" &
+ "casing#" &
+ "code#" &
+ "component#" &
+ "component_size_4#" &
+ "copy#" &
+ "d_float#" &
+ "descriptor#" &
+ "dot_replacement#" &
+ "dynamic#" &
+ "entity#" &
+ "external_name#" &
+ "first_optional_parameter#" &
+ "form#" &
+ "g_float#" &
+ "gcc#" &
+ "gnat#" &
+ "gpl#" &
+ "ieee_float#" &
+ "internal#" &
+ "link_name#" &
+ "lowercase#" &
+ "max_entry_queue_depth#" &
+ "max_entry_queue_length#" &
+ "max_size#" &
+ "mechanism#" &
+ "mixedcase#" &
+ "modified_gpl#" &
+ "name#" &
+ "nca#" &
+ "no#" &
+ "no_dependence#" &
+ "no_dynamic_attachment#" &
+ "no_dynamic_interrupts#" &
+ "no_requeue#" &
+ "no_requeue_statements#" &
+ "no_task_attributes#" &
+ "no_task_attributes_package#" &
+ "on#" &
+ "parameter_types#" &
+ "reference#" &
+ "restricted#" &
+ "result_mechanism#" &
+ "result_type#" &
+ "runtime#" &
+ "sb#" &
+ "secondary_stack_size#" &
+ "section#" &
+ "semaphore#" &
+ "simple_barriers#" &
+ "spec_file_name#" &
+ "static#" &
+ "stack_size#" &
+ "subunit_file_name#" &
+ "task_stack_size_default#" &
+ "task_type#" &
+ "time_slicing_enabled#" &
+ "top_guard#" &
+ "uba#" &
+ "ubs#" &
+ "ubsb#" &
+ "unit_name#" &
+ "unknown#" &
+ "unrestricted#" &
+ "uppercase#" &
+ "user#" &
+ "vax_float#" &
+ "vms#" &
+ "working_storage#" &
+ "abort_signal#" &
+ "access#" &
+ "address#" &
+ "address_size#" &
+ "aft#" &
+ "alignment#" &
+ "asm_input#" &
+ "asm_output#" &
+ "ast_entry#" &
+ "bit#" &
+ "bit_order#" &
+ "bit_position#" &
+ "body_version#" &
+ "callable#" &
+ "caller#" &
+ "code_address#" &
+ "component_size#" &
+ "compose#" &
+ "constrained#" &
+ "count#" &
+ "default_bit_order#" &
+ "definite#" &
+ "delta#" &
+ "denorm#" &
+ "digits#" &
+ "elaborated#" &
+ "emax#" &
+ "enum_rep#" &
+ "epsilon#" &
+ "exponent#" &
+ "external_tag#" &
+ "first#" &
+ "first_bit#" &
+ "fixed_value#" &
+ "fore#" &
+ "has_access_values#" &
+ "has_discriminants#" &
+ "identity#" &
+ "img#" &
+ "integer_value#" &
+ "large#" &
+ "last#" &
+ "last_bit#" &
+ "leading_part#" &
+ "length#" &
+ "machine_emax#" &
+ "machine_emin#" &
+ "machine_mantissa#" &
+ "machine_overflows#" &
+ "machine_radix#" &
+ "machine_rounds#" &
+ "machine_size#" &
+ "mantissa#" &
+ "max_size_in_storage_elements#" &
+ "maximum_alignment#" &
+ "mechanism_code#" &
+ "mod#" &
+ "model_emin#" &
+ "model_epsilon#" &
+ "model_mantissa#" &
+ "model_small#" &
+ "modulus#" &
+ "null_parameter#" &
+ "object_size#" &
+ "partition_id#" &
+ "passed_by_reference#" &
+ "pool_address#" &
+ "pos#" &
+ "position#" &
+ "range#" &
+ "range_length#" &
+ "round#" &
+ "safe_emax#" &
+ "safe_first#" &
+ "safe_large#" &
+ "safe_last#" &
+ "safe_small#" &
+ "scale#" &
+ "scaling#" &
+ "signed_zeros#" &
+ "size#" &
+ "small#" &
+ "storage_size#" &
+ "storage_unit#" &
+ "stream_size#" &
+ "tag#" &
+ "target_name#" &
+ "terminated#" &
+ "to_address#" &
+ "type_class#" &
+ "uet_address#" &
+ "unbiased_rounding#" &
+ "unchecked_access#" &
+ "unconstrained_array#" &
+ "universal_literal_string#" &
+ "unrestricted_access#" &
+ "vads_size#" &
+ "val#" &
+ "valid#" &
+ "value_size#" &
+ "version#" &
+ "wchar_t_size#" &
+ "wide_wide_width#" &
+ "wide_width#" &
+ "width#" &
+ "word_size#" &
+ "adjacent#" &
+ "ceiling#" &
+ "copy_sign#" &
+ "floor#" &
+ "fraction#" &
+ "image#" &
+ "input#" &
+ "machine#" &
+ "max#" &
+ "min#" &
+ "model#" &
+ "pred#" &
+ "remainder#" &
+ "rounding#" &
+ "succ#" &
+ "truncation#" &
+ "value#" &
+ "wide_image#" &
+ "wide_wide_image#" &
+ "wide_value#" &
+ "wide_wide_value#" &
+ "output#" &
+ "read#" &
+ "write#" &
+ "elab_body#" &
+ "elab_spec#" &
+ "storage_pool#" &
+ "base#" &
+ "class#" &
+ "ceiling_locking#" &
+ "inheritance_locking#" &
+ "fifo_queuing#" &
+ "priority_queuing#" &
+ "fifo_within_priorities#" &
+ "access_check#" &
+ "accessibility_check#" &
+ "discriminant_check#" &
+ "division_check#" &
+ "elaboration_check#" &
+ "index_check#" &
+ "length_check#" &
+ "overflow_check#" &
+ "range_check#" &
+ "storage_check#" &
+ "tag_check#" &
+ "all_checks#" &
+ "abort#" &
+ "abs#" &
+ "accept#" &
+ "and#" &
+ "all#" &
+ "array#" &
+ "at#" &
+ "begin#" &
+ "body#" &
+ "case#" &
+ "constant#" &
+ "declare#" &
+ "delay#" &
+ "do#" &
+ "else#" &
+ "elsif#" &
+ "end#" &
+ "entry#" &
+ "exception#" &
+ "exit#" &
+ "for#" &
+ "function#" &
+ "generic#" &
+ "goto#" &
+ "if#" &
+ "in#" &
+ "is#" &
+ "limited#" &
+ "loop#" &
+ "new#" &
+ "not#" &
+ "null#" &
+ "of#" &
+ "or#" &
+ "others#" &
+ "out#" &
+ "package#" &
+ "pragma#" &
+ "private#" &
+ "procedure#" &
+ "raise#" &
+ "record#" &
+ "rem#" &
+ "renames#" &
+ "return#" &
+ "reverse#" &
+ "select#" &
+ "separate#" &
+ "subtype#" &
+ "task#" &
+ "terminate#" &
+ "then#" &
+ "type#" &
+ "use#" &
+ "when#" &
+ "while#" &
+ "with#" &
+ "xor#" &
+ "divide#" &
+ "enclosing_entity#" &
+ "exception_information#" &
+ "exception_message#" &
+ "exception_name#" &
+ "file#" &
+ "import_address#" &
+ "import_largest_value#" &
+ "import_value#" &
+ "is_negative#" &
+ "line#" &
+ "rotate_left#" &
+ "rotate_right#" &
+ "shift_left#" &
+ "shift_right#" &
+ "shift_right_arithmetic#" &
+ "source_location#" &
+ "unchecked_conversion#" &
+ "unchecked_deallocation#" &
+ "to_pointer#" &
+ "abstract#" &
+ "aliased#" &
+ "protected#" &
+ "until#" &
+ "requeue#" &
+ "tagged#" &
+ "raise_exception#" &
+ "ada_roots#" &
+ "binder#" &
+ "binder_driver#" &
+ "body_suffix#" &
+ "builder#" &
+ "compiler#" &
+ "compiler_driver#" &
+ "compiler_kind#" &
+ "compute_dependency#" &
+ "cross_reference#" &
+ "default_linker#" &
+ "default_switches#" &
+ "dependency_option#" &
+ "exec_dir#" &
+ "executable#" &
+ "executable_suffix#" &
+ "extends#" &
+ "externally_built#" &
+ "finder#" &
+ "global_configuration_pragmas#" &
+ "gnatls#" &
+ "gnatstub#" &
+ "implementation#" &
+ "implementation_exceptions#" &
+ "implementation_suffix#" &
+ "include_option#" &
+ "language_processing#" &
+ "languages#" &
+ "library_dir#" &
+ "library_auto_init#" &
+ "library_gcc#" &
+ "library_interface#" &
+ "library_kind#" &
+ "library_name#" &
+ "library_options#" &
+ "library_reference_symbol_file#" &
+ "library_src_dir#" &
+ "library_symbol_file#" &
+ "library_symbol_policy#" &
+ "library_version#" &
+ "linker#" &
+ "local_configuration_pragmas#" &
+ "locally_removed_files#" &
+ "metrics#" &
+ "naming#" &
+ "object_dir#" &
+ "pretty_printer#" &
+ "project#" &
+ "separate_suffix#" &
+ "source_dirs#" &
+ "source_files#" &
+ "source_list_file#" &
+ "spec#" &
+ "spec_suffix#" &
+ "specification#" &
+ "specification_exceptions#" &
+ "specification_suffix#" &
+ "switches#" &
+ "unaligned_valid#" &
+ "interface#" &
+ "overriding#" &
+ "synchronized#" &
+ "#";
+
+ ---------------------
+ -- Generated Names --
+ ---------------------
+
+ -- This section lists the various cases of generated names which are
+ -- built from existing names by adding unique leading and/or trailing
+ -- upper case letters. In some cases these names are built recursively,
+ -- in particular names built from types may be built from types which
+ -- themselves have generated names. In this list, xxx represents an
+ -- existing name to which identifying letters are prepended or appended,
+ -- and a trailing n represents a serial number in an external name that
+ -- has some semantic significance (e.g. the n'th index type of an array).
+
+ -- xxxA access type for formal xxx in entry param record (Exp_Ch9)
+ -- xxxB tag table for tagged type xxx (Exp_Ch3)
+ -- xxxB task body procedure for task xxx (Exp_Ch9)
+ -- xxxD dispatch table for tagged type xxx (Exp_Ch3)
+ -- xxxD discriminal for discriminant xxx (Sem_Ch3)
+ -- xxxDn n'th discr check function for rec type xxx (Exp_Ch3)
+ -- xxxE elaboration boolean flag for task xxx (Exp_Ch9)
+ -- xxxE dispatch table pointer type for tagged type xxx (Exp_Ch3)
+ -- xxxE parameters for accept body for entry xxx (Exp_Ch9)
+ -- xxxFn n'th primitive of a tagged type (named xxx) (Exp_Ch3)
+ -- xxxJ tag table type index for tagged type xxx (Exp_Ch3)
+ -- xxxM master Id value for access type xxx (Exp_Ch3)
+ -- xxxP tag table pointer type for tagged type xxx (Exp_Ch3)
+ -- xxxP parameter record type for entry xxx (Exp_Ch9)
+ -- xxxPA access to parameter record type for entry xxx (Exp_Ch9)
+ -- xxxPn pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
+ -- xxxR dispatch table pointer for tagged type xxx (Exp_Ch3)
+ -- xxxT tag table type for tagged type xxx (Exp_Ch3)
+ -- xxxT literal table for enumeration type xxx (Sem_Ch3)
+ -- xxxV type for task value record for task xxx (Exp_Ch9)
+ -- xxxX entry index constant (Exp_Ch9)
+ -- xxxY dispatch table type for tagged type xxx (Exp_Ch3)
+ -- xxxZ size variable for task xxx (Exp_Ch9)
+
+ -- TSS names
+
+ -- xxxDA deep adjust routine for type xxx (Exp_TSS)
+ -- xxxDF deep finalize routine for type xxx (Exp_TSS)
+ -- xxxDI deep initialize routine for type xxx (Exp_TSS)
+ -- xxxEQ composite equality routine for record type xxx (Exp_TSS)
+ -- xxxIP initialization procedure for type xxx (Exp_TSS)
+ -- xxxRA RAs type access routine for type xxx (Exp_TSS)
+ -- xxxRD RAs type dereference routine for type xxx (Exp_TSS)
+ -- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS)
+ -- xxxSA array/slice assignment for controlled comp. arrays (Exp_TSS)
+ -- xxxSI stream input attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSO stream output attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSR stream read attribute subprogram for type xxx (Exp_TSS)
+ -- xxxSW stream write attribute subprogram for type xxx (Exp_TSS)
+
+ -- Implicit type names
+
+ -- TxxxT type of literal table for enumeration type xxx (Sem_Ch3)
+
+ -- (Note: this list is not complete or accurate ???)
+
+ ----------------------
+ -- Get_Attribute_Id --
+ ----------------------
+
+ function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
+ begin
+ return Attribute_Id'Val (N - First_Attribute_Name);
+ end Get_Attribute_Id;
+
+ ------------------
+ -- Get_Check_Id --
+ ------------------
+
+ function Get_Check_Id (N : Name_Id) return Check_Id is
+ begin
+ return Check_Id'Val (N - First_Check_Name);
+ end Get_Check_Id;
+
+ -----------------------
+ -- Get_Convention_Id --
+ -----------------------
+
+ function Get_Convention_Id (N : Name_Id) return Convention_Id is
+ begin
+ case N is
+ when Name_Ada => return Convention_Ada;
+ when Name_Assembler => return Convention_Assembler;
+ when Name_C => return Convention_C;
+ when Name_COBOL => return Convention_COBOL;
+ when Name_CPP => return Convention_CPP;
+ when Name_Fortran => return Convention_Fortran;
+ when Name_Intrinsic => return Convention_Intrinsic;
+ when Name_Java => return Convention_Java;
+ when Name_Stdcall => return Convention_Stdcall;
+ when Name_Stubbed => return Convention_Stubbed;
+
+ -- If no direct match, then we must have a convention
+ -- identifier pragma that has specified this name.
+
+ when others =>
+ for J in 1 .. Convention_Identifiers.Last loop
+ if N = Convention_Identifiers.Table (J).Name then
+ return Convention_Identifiers.Table (J).Convention;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end case;
+ end Get_Convention_Id;
+
+ ---------------------------
+ -- Get_Locking_Policy_Id --
+ ---------------------------
+
+ function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
+ begin
+ return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
+ end Get_Locking_Policy_Id;
+
+ -------------------
+ -- Get_Pragma_Id --
+ -------------------
+
+ function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
+ begin
+ if N = Name_AST_Entry then
+ return Pragma_AST_Entry;
+ elsif N = Name_Interface then
+ return Pragma_Interface;
+ elsif N = Name_Storage_Size then
+ return Pragma_Storage_Size;
+ elsif N = Name_Storage_Unit then
+ return Pragma_Storage_Unit;
+ elsif N not in First_Pragma_Name .. Last_Pragma_Name then
+ return Unknown_Pragma;
+ else
+ return Pragma_Id'Val (N - First_Pragma_Name);
+ end if;
+ end Get_Pragma_Id;
+
+ ---------------------------
+ -- Get_Queuing_Policy_Id --
+ ---------------------------
+
+ function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
+ begin
+ return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
+ end Get_Queuing_Policy_Id;
+
+ ------------------------------------
+ -- Get_Task_Dispatching_Policy_Id --
+ ------------------------------------
+
+ function Get_Task_Dispatching_Policy_Id (N : Name_Id)
+ return Task_Dispatching_Policy_Id is
+ begin
+ return Task_Dispatching_Policy_Id'Val
+ (N - First_Task_Dispatching_Policy_Name);
+ end Get_Task_Dispatching_Policy_Id;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize is
+ P_Index : Natural;
+ Discard_Name : Name_Id;
+
+ begin
+ P_Index := Preset_Names'First;
+
+ loop
+ Name_Len := 0;
+
+ while Preset_Names (P_Index) /= '#' loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Preset_Names (P_Index);
+ P_Index := P_Index + 1;
+ end loop;
+
+ -- We do the Name_Find call to enter the name into the table, but
+ -- we don't need to do anything with the result, since we already
+ -- initialized all the preset names to have the right value (we
+ -- are depending on the order of the names and Preset_Names).
+
+ Discard_Name := Name_Find;
+ P_Index := P_Index + 1;
+ exit when Preset_Names (P_Index) = '#';
+ end loop;
+
+ -- Make sure that number of names in standard table is correct. If
+ -- this check fails, run utility program XSNAMES to construct a new
+ -- properly matching version of the body.
+
+ pragma Assert (Discard_Name = Last_Predefined_Name);
+
+ -- Initialize the convention identifiers table with the standard
+ -- set of synonyms that we recognize for conventions.
+
+ Convention_Identifiers.Init;
+
+ Convention_Identifiers.Append ((Name_Asm, Convention_Assembler));
+ Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));
+
+ Convention_Identifiers.Append ((Name_Default, Convention_C));
+ Convention_Identifiers.Append ((Name_External, Convention_C));
+
+ Convention_Identifiers.Append ((Name_DLL, Convention_Stdcall));
+ Convention_Identifiers.Append ((Name_Win32, Convention_Stdcall));
+ end Initialize;
+
+ -----------------------
+ -- Is_Attribute_Name --
+ -----------------------
+
+ function Is_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Attribute_Name .. Last_Attribute_Name;
+ end Is_Attribute_Name;
+
+ -------------------
+ -- Is_Check_Name --
+ -------------------
+
+ function Is_Check_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Check_Name .. Last_Check_Name;
+ end Is_Check_Name;
+
+ ------------------------
+ -- Is_Convention_Name --
+ ------------------------
+
+ function Is_Convention_Name (N : Name_Id) return Boolean is
+ begin
+ -- Check if this is one of the standard conventions
+
+ if N in First_Convention_Name .. Last_Convention_Name
+ or else N = Name_C
+ then
+ return True;
+
+ -- Otherwise check if it is in convention identifier table
+
+ else
+ for J in 1 .. Convention_Identifiers.Last loop
+ if N = Convention_Identifiers.Table (J).Name then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end if;
+ end Is_Convention_Name;
+
+ ------------------------------
+ -- Is_Entity_Attribute_Name --
+ ------------------------------
+
+ function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
+ end Is_Entity_Attribute_Name;
+
+ --------------------------------
+ -- Is_Function_Attribute_Name --
+ --------------------------------
+
+ function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in
+ First_Renamable_Function_Attribute ..
+ Last_Renamable_Function_Attribute;
+ end Is_Function_Attribute_Name;
+
+ ----------------------------
+ -- Is_Locking_Policy_Name --
+ ----------------------------
+
+ function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
+ end Is_Locking_Policy_Name;
+
+ -----------------------------
+ -- Is_Operator_Symbol_Name --
+ -----------------------------
+
+ function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Operator_Name .. Last_Operator_Name;
+ end Is_Operator_Symbol_Name;
+
+ --------------------
+ -- Is_Pragma_Name --
+ --------------------
+
+ function Is_Pragma_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Pragma_Name .. Last_Pragma_Name
+ or else N = Name_AST_Entry
+ or else N = Name_Interface
+ or else N = Name_Storage_Size
+ or else N = Name_Storage_Unit;
+ end Is_Pragma_Name;
+
+ ---------------------------------
+ -- Is_Procedure_Attribute_Name --
+ ---------------------------------
+
+ function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
+ end Is_Procedure_Attribute_Name;
+
+ ----------------------------
+ -- Is_Queuing_Policy_Name --
+ ----------------------------
+
+ function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
+ end Is_Queuing_Policy_Name;
+
+ -------------------------------------
+ -- Is_Task_Dispatching_Policy_Name --
+ -------------------------------------
+
+ function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Task_Dispatching_Policy_Name ..
+ Last_Task_Dispatching_Policy_Name;
+ end Is_Task_Dispatching_Policy_Name;
+
+ ----------------------------
+ -- Is_Type_Attribute_Name --
+ ----------------------------
+
+ function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
+ begin
+ return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
+ end Is_Type_Attribute_Name;
+
+ ----------------------------------
+ -- Record_Convention_Identifier --
+ ----------------------------------
+
+ procedure Record_Convention_Identifier
+ (Id : Name_Id;
+ Convention : Convention_Id)
+ is
+ begin
+ Convention_Identifiers.Append ((Id, Convention));
+ end Record_Convention_Identifier;
+
+end Snames;
-------------------------------------------------------------------------------\r
--- --\r
--- GNAT COMPILER COMPONENTS --\r
--- --\r
--- S N A M E S --\r
--- --\r
--- S p e c --\r
--- --\r
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --\r
--- --\r
--- GNAT is free software; you can redistribute it and/or modify it under --\r
--- terms of the GNU General Public License as published by the Free Soft- --\r
--- ware Foundation; either version 2, or (at your option) any later ver- --\r
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --\r
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --\r
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --\r
--- for more details. You should have received a copy of the GNU General --\r
--- Public License distributed with GNAT; see file COPYING. If not, write --\r
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --\r
--- MA 02111-1307, USA. --\r
--- --\r
--- As a special exception, if other files instantiate generics from this --\r
--- unit, or you link this unit with other files to produce an executable, --\r
--- this unit does not by itself cause the resulting executable to be --\r
--- covered by the GNU General Public License. This exception does not --\r
--- however invalidate any other reasons why the executable file might be --\r
--- covered by the GNU Public License. --\r
--- --\r
--- GNAT was originally developed by the GNAT team at New York University. --\r
--- Extensive contributions were provided by Ada Core Technologies Inc. --\r
--- --\r
-------------------------------------------------------------------------------\r
-\r
-with Types; use Types;\r
-\r
-package Snames is\r
-\r
--- This package contains definitions of standard names (i.e. entries in the\r
--- Names table) that are used throughout the GNAT compiler). It also contains\r
--- the definitions of some enumeration types whose definitions are tied to\r
--- the order of these preset names.\r
-\r
--- WARNING: There is a C file, a-snames.h which duplicates some of the\r
--- definitions in this file and must be kept properly synchronized.\r
-\r
- ------------------\r
- -- Preset Names --\r
- ------------------\r
-\r
- -- The following are preset entries in the names table, which are\r
- -- entered at the start of every compilation for easy access. Note\r
- -- that the order of initialization of these names in the body must\r
- -- be coordinated with the order of names in this table.\r
-\r
- -- Note: a name may not appear more than once in the following list.\r
- -- If additional pragmas or attributes are introduced which might\r
- -- otherwise cause a duplicate, then list it only once in this table,\r
- -- and adjust the definition of the functions for testing for pragma\r
- -- names and attribute names, and returning their ID values. Of course\r
- -- everything is simpler if no such duplications occur!\r
-\r
- -- First we have the one character names used to optimize the lookup\r
- -- process for one character identifiers (to avoid the hashing in this\r
- -- case) There are a full 256 of these, but only the entries for lower\r
- -- case and upper case letters have identifiers\r
-\r
- -- The lower case letter entries are used for one character identifiers\r
- -- appearing in the source, for example in pragma Interface (C).\r
-\r
- Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a');\r
- Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b');\r
- Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c');\r
- Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d');\r
- Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e');\r
- Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f');\r
- Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g');\r
- Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h');\r
- Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i');\r
- Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j');\r
- Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k');\r
- Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l');\r
- Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m');\r
- Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n');\r
- Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o');\r
- Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p');\r
- Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q');\r
- Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r');\r
- Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s');\r
- Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t');\r
- Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u');\r
- Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v');\r
- Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w');\r
- Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x');\r
- Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y');\r
- Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z');\r
-\r
- -- The upper case letter entries are used by expander code for local\r
- -- variables that do not require unique names (e.g. formal parameter\r
- -- names in constructed procedures)\r
-\r
- Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A');\r
- Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B');\r
- Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C');\r
- Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D');\r
- Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E');\r
- Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F');\r
- Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G');\r
- Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H');\r
- Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I');\r
- Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J');\r
- Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K');\r
- Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L');\r
- Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M');\r
- Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N');\r
- Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O');\r
- Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P');\r
- Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q');\r
- Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R');\r
- Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S');\r
- Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T');\r
- Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U');\r
- Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V');\r
- Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W');\r
- Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X');\r
- Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');\r
- Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');\r
-\r
- -- Note: the following table is read by the utility program XSNAMES and\r
- -- its format should not be changed without coordinating with this program.\r
-\r
- N : constant Name_Id := First_Name_Id + 256;\r
- -- Synonym used in standard name definitions\r
-\r
- -- Some names that are used by gigi, and whose definitions are reflected\r
- -- in the C header file a-snames.h. They are placed at the start so that\r
- -- the need to modify a-snames.h is minimized.\r
-\r
- Name_uParent : constant Name_Id := N + 000;\r
- Name_uTag : constant Name_Id := N + 001;\r
- Name_Off : constant Name_Id := N + 002;\r
- Name_Space : constant Name_Id := N + 003;\r
- Name_Time : constant Name_Id := N + 004;\r
-\r
- -- Some special names used by the expander. Note that the lower case u's\r
- -- at the start of these names get translated to extra underscores. These\r
- -- names are only referenced internally by expander generated code.\r
-\r
- Name_uAbort_Signal : constant Name_Id := N + 005;\r
- Name_uAlignment : constant Name_Id := N + 006;\r
- Name_uAssign : constant Name_Id := N + 007;\r
- Name_uATCB : constant Name_Id := N + 008;\r
- Name_uChain : constant Name_Id := N + 009;\r
- Name_uClean : constant Name_Id := N + 010;\r
- Name_uController : constant Name_Id := N + 011;\r
- Name_uEntry_Bodies : constant Name_Id := N + 012;\r
- Name_uExpunge : constant Name_Id := N + 013;\r
- Name_uFinal_List : constant Name_Id := N + 014;\r
- Name_uIdepth : constant Name_Id := N + 015;\r
- Name_uInit : constant Name_Id := N + 016;\r
- Name_uLocal_Final_List : constant Name_Id := N + 017;\r
- Name_uMaster : constant Name_Id := N + 018;\r
- Name_uObject : constant Name_Id := N + 019;\r
- Name_uPriority : constant Name_Id := N + 020;\r
- Name_uProcess_ATSD : constant Name_Id := N + 021;\r
- Name_uSecondary_Stack : constant Name_Id := N + 022;\r
- Name_uService : constant Name_Id := N + 023;\r
- Name_uSize : constant Name_Id := N + 024;\r
- Name_uStack : constant Name_Id := N + 025;\r
- Name_uTags : constant Name_Id := N + 026;\r
- Name_uTask : constant Name_Id := N + 027;\r
- Name_uTask_Id : constant Name_Id := N + 028;\r
- Name_uTask_Info : constant Name_Id := N + 029;\r
- Name_uTask_Name : constant Name_Id := N + 030;\r
- Name_uTrace_Sp : constant Name_Id := N + 031;\r
-\r
- -- Names of routines in Ada.Finalization, needed by expander\r
-\r
- Name_Initialize : constant Name_Id := N + 032;\r
- Name_Adjust : constant Name_Id := N + 033;\r
- Name_Finalize : constant Name_Id := N + 034;\r
-\r
- -- Names of fields declared in System.Finalization_Implementation,\r
- -- needed by the expander when generating code for finalization.\r
-\r
- Name_Next : constant Name_Id := N + 035;\r
- Name_Prev : constant Name_Id := N + 036;\r
-\r
- -- Names of TSS routines for implementation of DSA over PolyORB\r
-\r
- Name_uTypeCode : constant Name_Id := N + 037;\r
- Name_uFrom_Any : constant Name_Id := N + 038;\r
- Name_uTo_Any : constant Name_Id := N + 039;\r
-\r
- -- Names of allocation routines, also needed by expander\r
-\r
- Name_Allocate : constant Name_Id := N + 040;\r
- Name_Deallocate : constant Name_Id := N + 041;\r
- Name_Dereference : constant Name_Id := N + 042;\r
-\r
- -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)\r
-\r
- First_Text_IO_Package : constant Name_Id := N + 043;\r
- Name_Decimal_IO : constant Name_Id := N + 043;\r
- Name_Enumeration_IO : constant Name_Id := N + 044;\r
- Name_Fixed_IO : constant Name_Id := N + 045;\r
- Name_Float_IO : constant Name_Id := N + 046;\r
- Name_Integer_IO : constant Name_Id := N + 047;\r
- Name_Modular_IO : constant Name_Id := N + 048;\r
- Last_Text_IO_Package : constant Name_Id := N + 048;\r
-\r
- subtype Text_IO_Package_Name is Name_Id\r
- range First_Text_IO_Package .. Last_Text_IO_Package;\r
-\r
- -- Some miscellaneous names used for error detection/recovery\r
-\r
- Name_Const : constant Name_Id := N + 049;\r
- Name_Error : constant Name_Id := N + 050;\r
- Name_Go : constant Name_Id := N + 051;\r
- Name_Put : constant Name_Id := N + 052;\r
- Name_Put_Line : constant Name_Id := N + 053;\r
- Name_To : constant Name_Id := N + 054;\r
-\r
- -- Names for packages that are treated specially by the compiler\r
-\r
- Name_Finalization : constant Name_Id := N + 055;\r
- Name_Finalization_Root : constant Name_Id := N + 056;\r
- Name_Interfaces : constant Name_Id := N + 057;\r
- Name_Standard : constant Name_Id := N + 058;\r
- Name_System : constant Name_Id := N + 059;\r
- Name_Text_IO : constant Name_Id := N + 060;\r
- Name_Wide_Text_IO : constant Name_Id := N + 061;\r
- Name_Wide_Wide_Text_IO : constant Name_Id := N + 062;\r
-\r
- -- Names of implementations of the distributed systems annex\r
-\r
- First_PCS_Name : constant Name_Id := N + 063;\r
- Name_No_DSA : constant Name_Id := N + 063;\r
- Name_GARLIC_DSA : constant Name_Id := N + 064;\r
- Name_PolyORB_DSA : constant Name_Id := N + 065;\r
- Last_PCS_Name : constant Name_Id := N + 065;\r
-\r
- subtype PCS_Names is Name_Id\r
- range First_PCS_Name .. Last_PCS_Name;\r
-\r
- -- Names of identifiers used in expanding distribution stubs\r
-\r
- Name_Addr : constant Name_Id := N + 066;\r
- Name_Async : constant Name_Id := N + 067;\r
- Name_Get_Active_Partition_ID : constant Name_Id := N + 068;\r
- Name_Get_RCI_Package_Receiver : constant Name_Id := N + 069;\r
- Name_Get_RCI_Package_Ref : constant Name_Id := N + 070;\r
- Name_Origin : constant Name_Id := N + 071;\r
- Name_Params : constant Name_Id := N + 072;\r
- Name_Partition : constant Name_Id := N + 073;\r
- Name_Partition_Interface : constant Name_Id := N + 074;\r
- Name_Ras : constant Name_Id := N + 075;\r
- Name_Call : constant Name_Id := N + 076;\r
- Name_RCI_Name : constant Name_Id := N + 077;\r
- Name_Receiver : constant Name_Id := N + 078;\r
- Name_Result : constant Name_Id := N + 079;\r
- Name_Rpc : constant Name_Id := N + 080;\r
- Name_Subp_Id : constant Name_Id := N + 081;\r
- Name_Operation : constant Name_Id := N + 082;\r
- Name_Argument : constant Name_Id := N + 083;\r
- Name_Arg_Modes : constant Name_Id := N + 084;\r
- Name_Handler : constant Name_Id := N + 085;\r
- Name_Target : constant Name_Id := N + 086;\r
- Name_Req : constant Name_Id := N + 087;\r
- Name_Obj_TypeCode : constant Name_Id := N + 088;\r
- Name_Stub : constant Name_Id := N + 089;\r
-\r
- -- Operator Symbol entries. The actual names have an upper case O at\r
- -- the start in place of the Op_ prefix (e.g. the actual name that\r
- -- corresponds to Name_Op_Abs is "Oabs".\r
-\r
- First_Operator_Name : constant Name_Id := N + 090;\r
- Name_Op_Abs : constant Name_Id := N + 090; -- "abs"\r
- Name_Op_And : constant Name_Id := N + 091; -- "and"\r
- Name_Op_Mod : constant Name_Id := N + 092; -- "mod"\r
- Name_Op_Not : constant Name_Id := N + 093; -- "not"\r
- Name_Op_Or : constant Name_Id := N + 094; -- "or"\r
- Name_Op_Rem : constant Name_Id := N + 095; -- "rem"\r
- Name_Op_Xor : constant Name_Id := N + 096; -- "xor"\r
- Name_Op_Eq : constant Name_Id := N + 097; -- "="\r
- Name_Op_Ne : constant Name_Id := N + 098; -- "/="\r
- Name_Op_Lt : constant Name_Id := N + 099; -- "<"\r
- Name_Op_Le : constant Name_Id := N + 100; -- "<="\r
- Name_Op_Gt : constant Name_Id := N + 101; -- ">"\r
- Name_Op_Ge : constant Name_Id := N + 102; -- ">="\r
- Name_Op_Add : constant Name_Id := N + 103; -- "+"\r
- Name_Op_Subtract : constant Name_Id := N + 104; -- "-"\r
- Name_Op_Concat : constant Name_Id := N + 105; -- "&"\r
- Name_Op_Multiply : constant Name_Id := N + 106; -- "*"\r
- Name_Op_Divide : constant Name_Id := N + 107; -- "/"\r
- Name_Op_Expon : constant Name_Id := N + 108; -- "**"\r
- Last_Operator_Name : constant Name_Id := N + 108;\r
-\r
- -- Names for all pragmas recognized by GNAT. The entries with the comment\r
- -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95.\r
- -- These pragmas are fully implemented in both Ada 83 and Ada 95 modes\r
- -- in GNAT.\r
-\r
- -- The entries marked GNAT are pragmas that are defined by GNAT\r
- -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions\r
- -- of these implementation dependent pragmas may be found in the\r
- -- appropriate section in unit Sem_Prag in file sem-prag.adb.\r
-\r
- -- The entries marked Ada05 are technically implementation dependent\r
- -- pragmas, but they correspond to standard proposals for Ada 2005.\r
-\r
- -- The entries marked VMS are VMS specific pragmas that are recognized\r
- -- only in OpenVMS versions of GNAT. They are ignored in other versions\r
- -- with an appropriate warning.\r
-\r
- -- The entries marked AAMP are AAMP specific pragmas that are recognized\r
- -- only in GNAT for the AAMP. They are ignored in other versions with\r
- -- appropriate warnings.\r
-\r
- First_Pragma_Name : constant Name_Id := N + 109;\r
-\r
- -- Configuration pragmas are grouped at start\r
-\r
- Name_Ada_83 : constant Name_Id := N + 109; -- GNAT\r
- Name_Ada_95 : constant Name_Id := N + 110; -- GNAT\r
- Name_Ada_05 : constant Name_Id := N + 111; -- GNAT\r
- Name_C_Pass_By_Copy : constant Name_Id := N + 112; -- GNAT\r
- Name_Compile_Time_Warning : constant Name_Id := N + 113; -- GNAT\r
- Name_Component_Alignment : constant Name_Id := N + 114; -- GNAT\r
- Name_Convention_Identifier : constant Name_Id := N + 115; -- GNAT\r
- Name_Detect_Blocking : constant Name_Id := N + 116; -- Ada05\r
- Name_Discard_Names : constant Name_Id := N + 117;\r
- Name_Elaboration_Checks : constant Name_Id := N + 118; -- GNAT\r
- Name_Eliminate : constant Name_Id := N + 119; -- GNAT\r
- Name_Explicit_Overriding : constant Name_Id := N + 120;\r
- Name_Extend_System : constant Name_Id := N + 121; -- GNAT\r
- Name_Extensions_Allowed : constant Name_Id := N + 122; -- GNAT\r
- Name_External_Name_Casing : constant Name_Id := N + 123; -- GNAT\r
- Name_Float_Representation : constant Name_Id := N + 124; -- GNAT\r
- Name_Initialize_Scalars : constant Name_Id := N + 125; -- GNAT\r
- Name_Interrupt_State : constant Name_Id := N + 126; -- GNAT\r
- Name_License : constant Name_Id := N + 127; -- GNAT\r
- Name_Locking_Policy : constant Name_Id := N + 128;\r
- Name_Long_Float : constant Name_Id := N + 129; -- VMS\r
- Name_No_Run_Time : constant Name_Id := N + 130; -- GNAT\r
- Name_No_Strict_Aliasing : constant Name_Id := N + 131; -- GNAT\r
- Name_Normalize_Scalars : constant Name_Id := N + 132;\r
- Name_Polling : constant Name_Id := N + 133; -- GNAT\r
- Name_Persistent_Data : constant Name_Id := N + 134; -- GNAT\r
- Name_Persistent_Object : constant Name_Id := N + 135; -- GNAT\r
- Name_Profile : constant Name_Id := N + 136; -- Ada05\r
- Name_Profile_Warnings : constant Name_Id := N + 137; -- GNAT\r
- Name_Propagate_Exceptions : constant Name_Id := N + 138; -- GNAT\r
- Name_Queuing_Policy : constant Name_Id := N + 139;\r
- Name_Ravenscar : constant Name_Id := N + 140;\r
- Name_Restricted_Run_Time : constant Name_Id := N + 141;\r
- Name_Restrictions : constant Name_Id := N + 142;\r
- Name_Restriction_Warnings : constant Name_Id := N + 143; -- GNAT\r
- Name_Reviewable : constant Name_Id := N + 144;\r
- Name_Source_File_Name : constant Name_Id := N + 145; -- GNAT\r
- Name_Source_File_Name_Project : constant Name_Id := N + 146; -- GNAT\r
- Name_Style_Checks : constant Name_Id := N + 147; -- GNAT\r
- Name_Suppress : constant Name_Id := N + 148;\r
- Name_Suppress_Exception_Locations : constant Name_Id := N + 149; -- GNAT\r
- Name_Task_Dispatching_Policy : constant Name_Id := N + 150;\r
- Name_Universal_Data : constant Name_Id := N + 151; -- AAMP\r
- Name_Unsuppress : constant Name_Id := N + 152; -- GNAT\r
- Name_Use_VADS_Size : constant Name_Id := N + 153; -- GNAT\r
- Name_Validity_Checks : constant Name_Id := N + 154; -- GNAT\r
- Name_Warnings : constant Name_Id := N + 155; -- GNAT\r
- Last_Configuration_Pragma_Name : constant Name_Id := N + 155;\r
-\r
- -- Remaining pragma names\r
-\r
- Name_Abort_Defer : constant Name_Id := N + 156; -- GNAT\r
- Name_All_Calls_Remote : constant Name_Id := N + 157;\r
- Name_Annotate : constant Name_Id := N + 158; -- GNAT\r
-\r
- -- Note: AST_Entry is not in this list because its name matches the\r
- -- name of the corresponding attribute. However, it is included in the\r
- -- definition of the type Attribute_Id, and the functions Get_Pragma_Id\r
- -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry.\r
- -- AST_Entry is a VMS specific pragma.\r
-\r
- Name_Assert : constant Name_Id := N + 159; -- GNAT\r
- Name_Asynchronous : constant Name_Id := N + 160;\r
- Name_Atomic : constant Name_Id := N + 161;\r
- Name_Atomic_Components : constant Name_Id := N + 162;\r
- Name_Attach_Handler : constant Name_Id := N + 163;\r
- Name_Comment : constant Name_Id := N + 164; -- GNAT\r
- Name_Common_Object : constant Name_Id := N + 165; -- GNAT\r
- Name_Complex_Representation : constant Name_Id := N + 166; -- GNAT\r
- Name_Controlled : constant Name_Id := N + 167;\r
- Name_Convention : constant Name_Id := N + 168;\r
- Name_CPP_Class : constant Name_Id := N + 169; -- GNAT\r
- Name_CPP_Constructor : constant Name_Id := N + 170; -- GNAT\r
- Name_CPP_Virtual : constant Name_Id := N + 171; -- GNAT\r
- Name_CPP_Vtable : constant Name_Id := N + 172; -- GNAT\r
- Name_Debug : constant Name_Id := N + 173; -- GNAT\r
- Name_Elaborate : constant Name_Id := N + 174; -- Ada 83\r
- Name_Elaborate_All : constant Name_Id := N + 175;\r
- Name_Elaborate_Body : constant Name_Id := N + 176;\r
- Name_Export : constant Name_Id := N + 177;\r
- Name_Export_Exception : constant Name_Id := N + 178; -- VMS\r
- Name_Export_Function : constant Name_Id := N + 179; -- GNAT\r
- Name_Export_Object : constant Name_Id := N + 180; -- GNAT\r
- Name_Export_Procedure : constant Name_Id := N + 181; -- GNAT\r
- Name_Export_Value : constant Name_Id := N + 182; -- GNAT\r
- Name_Export_Valued_Procedure : constant Name_Id := N + 183; -- GNAT\r
- Name_External : constant Name_Id := N + 184; -- GNAT\r
- Name_Finalize_Storage_Only : constant Name_Id := N + 185; -- GNAT\r
- Name_Ident : constant Name_Id := N + 186; -- VMS\r
- Name_Import : constant Name_Id := N + 187;\r
- Name_Import_Exception : constant Name_Id := N + 188; -- VMS\r
- Name_Import_Function : constant Name_Id := N + 189; -- GNAT\r
- Name_Import_Object : constant Name_Id := N + 190; -- GNAT\r
- Name_Import_Procedure : constant Name_Id := N + 191; -- GNAT\r
- Name_Import_Valued_Procedure : constant Name_Id := N + 192; -- GNAT\r
- Name_Inline : constant Name_Id := N + 193;\r
- Name_Inline_Always : constant Name_Id := N + 194; -- GNAT\r
- Name_Inline_Generic : constant Name_Id := N + 195; -- GNAT\r
- Name_Inspection_Point : constant Name_Id := N + 196;\r
- Name_Interface_Name : constant Name_Id := N + 197; -- GNAT\r
- Name_Interrupt_Handler : constant Name_Id := N + 198;\r
- Name_Interrupt_Priority : constant Name_Id := N + 199;\r
- Name_Java_Constructor : constant Name_Id := N + 200; -- GNAT\r
- Name_Java_Interface : constant Name_Id := N + 201; -- GNAT\r
- Name_Keep_Names : constant Name_Id := N + 202; -- GNAT\r
- Name_Link_With : constant Name_Id := N + 203; -- GNAT\r
- Name_Linker_Alias : constant Name_Id := N + 204; -- GNAT\r
- Name_Linker_Options : constant Name_Id := N + 205;\r
- Name_Linker_Section : constant Name_Id := N + 206; -- GNAT\r
- Name_List : constant Name_Id := N + 207;\r
- Name_Machine_Attribute : constant Name_Id := N + 208; -- GNAT\r
- Name_Main : constant Name_Id := N + 209; -- GNAT\r
- Name_Main_Storage : constant Name_Id := N + 210; -- GNAT\r
- Name_Memory_Size : constant Name_Id := N + 211; -- Ada 83\r
- Name_No_Return : constant Name_Id := N + 212; -- GNAT\r
- Name_Obsolescent : constant Name_Id := N + 213; -- GNAT\r
- Name_Optimize : constant Name_Id := N + 214;\r
- Name_Optional_Overriding : constant Name_Id := N + 215;\r
- Name_Pack : constant Name_Id := N + 216;\r
- Name_Page : constant Name_Id := N + 217;\r
- Name_Passive : constant Name_Id := N + 218; -- GNAT\r
- Name_Preelaborate : constant Name_Id := N + 219;\r
- Name_Priority : constant Name_Id := N + 220;\r
- Name_Psect_Object : constant Name_Id := N + 221; -- VMS\r
- Name_Pure : constant Name_Id := N + 222;\r
- Name_Pure_Function : constant Name_Id := N + 223; -- GNAT\r
- Name_Remote_Call_Interface : constant Name_Id := N + 224;\r
- Name_Remote_Types : constant Name_Id := N + 225;\r
- Name_Share_Generic : constant Name_Id := N + 226; -- GNAT\r
- Name_Shared : constant Name_Id := N + 227; -- Ada 83\r
- Name_Shared_Passive : constant Name_Id := N + 228;\r
-\r
- -- Note: Storage_Size is not in this list because its name matches the\r
- -- name of the corresponding attribute. However, it is included in the\r
- -- definition of the type Attribute_Id, and the functions Get_Pragma_Id\r
- -- and Check_Pragma_Id correctly recognize and process Name_Storage_Size.\r
-\r
- -- Note: Storage_Unit is also omitted from the list because of a clash\r
- -- with an attribute name, and is treated similarly.\r
-\r
- Name_Source_Reference : constant Name_Id := N + 229; -- GNAT\r
- Name_Stream_Convert : constant Name_Id := N + 230; -- GNAT\r
- Name_Subtitle : constant Name_Id := N + 231; -- GNAT\r
- Name_Suppress_All : constant Name_Id := N + 232; -- GNAT\r
- Name_Suppress_Debug_Info : constant Name_Id := N + 233; -- GNAT\r
- Name_Suppress_Initialization : constant Name_Id := N + 234; -- GNAT\r
- Name_System_Name : constant Name_Id := N + 235; -- Ada 83\r
- Name_Task_Info : constant Name_Id := N + 236; -- GNAT\r
- Name_Task_Name : constant Name_Id := N + 237; -- GNAT\r
- Name_Task_Storage : constant Name_Id := N + 238; -- VMS\r
- Name_Thread_Body : constant Name_Id := N + 239; -- GNAT\r
- Name_Time_Slice : constant Name_Id := N + 240; -- GNAT\r
- Name_Title : constant Name_Id := N + 241; -- GNAT\r
- Name_Unchecked_Union : constant Name_Id := N + 242; -- GNAT\r
- Name_Unimplemented_Unit : constant Name_Id := N + 243; -- GNAT\r
- Name_Unreferenced : constant Name_Id := N + 244; -- GNAT\r
- Name_Unreserve_All_Interrupts : constant Name_Id := N + 245; -- GNAT\r
- Name_Volatile : constant Name_Id := N + 246;\r
- Name_Volatile_Components : constant Name_Id := N + 247;\r
- Name_Weak_External : constant Name_Id := N + 248; -- GNAT\r
- Last_Pragma_Name : constant Name_Id := N + 248;\r
-\r
- -- Language convention names for pragma Convention/Export/Import/Interface\r
- -- Note that Name_C is not included in this list, since it was already\r
- -- declared earlier in the context of one-character identifier names\r
- -- (where the order is critical to the fast look up process).\r
-\r
- -- Note: there are no convention names corresponding to the conventions\r
- -- Entry and Protected, this is because these conventions cannot be\r
- -- specified by a pragma.\r
-\r
- First_Convention_Name : constant Name_Id := N + 249;\r
- Name_Ada : constant Name_Id := N + 249;\r
- Name_Assembler : constant Name_Id := N + 250;\r
- Name_COBOL : constant Name_Id := N + 251;\r
- Name_CPP : constant Name_Id := N + 252;\r
- Name_Fortran : constant Name_Id := N + 253;\r
- Name_Intrinsic : constant Name_Id := N + 254;\r
- Name_Java : constant Name_Id := N + 255;\r
- Name_Stdcall : constant Name_Id := N + 256;\r
- Name_Stubbed : constant Name_Id := N + 257;\r
- Last_Convention_Name : constant Name_Id := N + 257;\r
-\r
- -- The following names are preset as synonyms for Assembler\r
-\r
- Name_Asm : constant Name_Id := N + 258;\r
- Name_Assembly : constant Name_Id := N + 259;\r
-\r
- -- The following names are preset as synonyms for C\r
-\r
- Name_Default : constant Name_Id := N + 260;\r
- -- Name_Exernal (previously defined as pragma)\r
-\r
- -- The following names are present as synonyms for Stdcall\r
-\r
- Name_DLL : constant Name_Id := N + 261;\r
- Name_Win32 : constant Name_Id := N + 262;\r
-\r
- -- Other special names used in processing pragmas\r
-\r
- Name_As_Is : constant Name_Id := N + 263;\r
- Name_Body_File_Name : constant Name_Id := N + 264;\r
- Name_Boolean_Entry_Barriers : constant Name_Id := N + 265;\r
- Name_Casing : constant Name_Id := N + 266;\r
- Name_Code : constant Name_Id := N + 267;\r
- Name_Component : constant Name_Id := N + 268;\r
- Name_Component_Size_4 : constant Name_Id := N + 269;\r
- Name_Copy : constant Name_Id := N + 270;\r
- Name_D_Float : constant Name_Id := N + 271;\r
- Name_Descriptor : constant Name_Id := N + 272;\r
- Name_Dot_Replacement : constant Name_Id := N + 273;\r
- Name_Dynamic : constant Name_Id := N + 274;\r
- Name_Entity : constant Name_Id := N + 275;\r
- Name_External_Name : constant Name_Id := N + 276;\r
- Name_First_Optional_Parameter : constant Name_Id := N + 277;\r
- Name_Form : constant Name_Id := N + 278;\r
- Name_G_Float : constant Name_Id := N + 279;\r
- Name_Gcc : constant Name_Id := N + 280;\r
- Name_Gnat : constant Name_Id := N + 281;\r
- Name_GPL : constant Name_Id := N + 282;\r
- Name_IEEE_Float : constant Name_Id := N + 283;\r
- Name_Internal : constant Name_Id := N + 284;\r
- Name_Link_Name : constant Name_Id := N + 285;\r
- Name_Lowercase : constant Name_Id := N + 286;\r
- Name_Max_Entry_Queue_Depth : constant Name_Id := N + 287;\r
- Name_Max_Entry_Queue_Length : constant Name_Id := N + 288;\r
- Name_Max_Size : constant Name_Id := N + 289;\r
- Name_Mechanism : constant Name_Id := N + 290;\r
- Name_Mixedcase : constant Name_Id := N + 291;\r
- Name_Modified_GPL : constant Name_Id := N + 292;\r
- Name_Name : constant Name_Id := N + 293;\r
- Name_NCA : constant Name_Id := N + 294;\r
- Name_No : constant Name_Id := N + 295;\r
- Name_No_Dependence : constant Name_Id := N + 296;\r
- Name_No_Dynamic_Attachment : constant Name_Id := N + 297;\r
- Name_No_Dynamic_Interrupts : constant Name_Id := N + 298;\r
- Name_No_Requeue : constant Name_Id := N + 299;\r
- Name_No_Requeue_Statements : constant Name_Id := N + 300;\r
- Name_No_Task_Attributes : constant Name_Id := N + 301;\r
- Name_No_Task_Attributes_Package : constant Name_Id := N + 302;\r
- Name_On : constant Name_Id := N + 303;\r
- Name_Parameter_Types : constant Name_Id := N + 304;\r
- Name_Reference : constant Name_Id := N + 305;\r
- Name_Restricted : constant Name_Id := N + 306;\r
- Name_Result_Mechanism : constant Name_Id := N + 307;\r
- Name_Result_Type : constant Name_Id := N + 308;\r
- Name_Runtime : constant Name_Id := N + 309;\r
- Name_SB : constant Name_Id := N + 310;\r
- Name_Secondary_Stack_Size : constant Name_Id := N + 311;\r
- Name_Section : constant Name_Id := N + 312;\r
- Name_Semaphore : constant Name_Id := N + 313;\r
- Name_Simple_Barriers : constant Name_Id := N + 314;\r
- Name_Spec_File_Name : constant Name_Id := N + 315;\r
- Name_Static : constant Name_Id := N + 316;\r
- Name_Stack_Size : constant Name_Id := N + 317;\r
- Name_Subunit_File_Name : constant Name_Id := N + 318;\r
- Name_Task_Stack_Size_Default : constant Name_Id := N + 319;\r
- Name_Task_Type : constant Name_Id := N + 320;\r
- Name_Time_Slicing_Enabled : constant Name_Id := N + 321;\r
- Name_Top_Guard : constant Name_Id := N + 322;\r
- Name_UBA : constant Name_Id := N + 323;\r
- Name_UBS : constant Name_Id := N + 324;\r
- Name_UBSB : constant Name_Id := N + 325;\r
- Name_Unit_Name : constant Name_Id := N + 326;\r
- Name_Unknown : constant Name_Id := N + 327;\r
- Name_Unrestricted : constant Name_Id := N + 328;\r
- Name_Uppercase : constant Name_Id := N + 329;\r
- Name_User : constant Name_Id := N + 330;\r
- Name_VAX_Float : constant Name_Id := N + 331;\r
- Name_VMS : constant Name_Id := N + 332;\r
- Name_Working_Storage : constant Name_Id := N + 333;\r
-\r
- -- Names of recognized attributes. The entries with the comment "Ada 83"\r
- -- are attributes that are defined in Ada 83, but not in Ada 95. These\r
- -- attributes are implemented in both Ada 83 and Ada 95 modes in GNAT.\r
-\r
- -- The entries marked GNAT are attributes that are defined by GNAT\r
- -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions\r
- -- of these implementation dependent attributes may be found in the\r
- -- appropriate section in package Sem_Attr in file sem-attr.ads.\r
-\r
- -- The entries marked VMS are recognized only in OpenVMS implementations\r
- -- of GNAT, and are treated as illegal in all other contexts.\r
-\r
- First_Attribute_Name : constant Name_Id := N + 334;\r
- Name_Abort_Signal : constant Name_Id := N + 334; -- GNAT\r
- Name_Access : constant Name_Id := N + 335;\r
- Name_Address : constant Name_Id := N + 336;\r
- Name_Address_Size : constant Name_Id := N + 337; -- GNAT\r
- Name_Aft : constant Name_Id := N + 338;\r
- Name_Alignment : constant Name_Id := N + 339;\r
- Name_Asm_Input : constant Name_Id := N + 340; -- GNAT\r
- Name_Asm_Output : constant Name_Id := N + 341; -- GNAT\r
- Name_AST_Entry : constant Name_Id := N + 342; -- VMS\r
- Name_Bit : constant Name_Id := N + 343; -- GNAT\r
- Name_Bit_Order : constant Name_Id := N + 344;\r
- Name_Bit_Position : constant Name_Id := N + 345; -- GNAT\r
- Name_Body_Version : constant Name_Id := N + 346;\r
- Name_Callable : constant Name_Id := N + 347;\r
- Name_Caller : constant Name_Id := N + 348;\r
- Name_Code_Address : constant Name_Id := N + 349; -- GNAT\r
- Name_Component_Size : constant Name_Id := N + 350;\r
- Name_Compose : constant Name_Id := N + 351;\r
- Name_Constrained : constant Name_Id := N + 352;\r
- Name_Count : constant Name_Id := N + 353;\r
- Name_Default_Bit_Order : constant Name_Id := N + 354; -- GNAT\r
- Name_Definite : constant Name_Id := N + 355;\r
- Name_Delta : constant Name_Id := N + 356;\r
- Name_Denorm : constant Name_Id := N + 357;\r
- Name_Digits : constant Name_Id := N + 358;\r
- Name_Elaborated : constant Name_Id := N + 359; -- GNAT\r
- Name_Emax : constant Name_Id := N + 360; -- Ada 83\r
- Name_Enum_Rep : constant Name_Id := N + 361; -- GNAT\r
- Name_Epsilon : constant Name_Id := N + 362; -- Ada 83\r
- Name_Exponent : constant Name_Id := N + 363;\r
- Name_External_Tag : constant Name_Id := N + 364;\r
- Name_First : constant Name_Id := N + 365;\r
- Name_First_Bit : constant Name_Id := N + 366;\r
- Name_Fixed_Value : constant Name_Id := N + 367; -- GNAT\r
- Name_Fore : constant Name_Id := N + 368;\r
- Name_Has_Access_Values : constant Name_Id := N + 369; -- GNAT\r
- Name_Has_Discriminants : constant Name_Id := N + 370; -- GNAT\r
- Name_Identity : constant Name_Id := N + 371;\r
- Name_Img : constant Name_Id := N + 372; -- GNAT\r
- Name_Integer_Value : constant Name_Id := N + 373; -- GNAT\r
- Name_Large : constant Name_Id := N + 374; -- Ada 83\r
- Name_Last : constant Name_Id := N + 375;\r
- Name_Last_Bit : constant Name_Id := N + 376;\r
- Name_Leading_Part : constant Name_Id := N + 377;\r
- Name_Length : constant Name_Id := N + 378;\r
- Name_Machine_Emax : constant Name_Id := N + 379;\r
- Name_Machine_Emin : constant Name_Id := N + 380;\r
- Name_Machine_Mantissa : constant Name_Id := N + 381;\r
- Name_Machine_Overflows : constant Name_Id := N + 382;\r
- Name_Machine_Radix : constant Name_Id := N + 383;\r
- Name_Machine_Rounds : constant Name_Id := N + 384;\r
- Name_Machine_Size : constant Name_Id := N + 385; -- GNAT\r
- Name_Mantissa : constant Name_Id := N + 386; -- Ada 83\r
- Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 387;\r
- Name_Maximum_Alignment : constant Name_Id := N + 388; -- GNAT\r
- Name_Mechanism_Code : constant Name_Id := N + 389; -- GNAT\r
- Name_Mod : constant Name_Id := N + 390;\r
- Name_Model_Emin : constant Name_Id := N + 391;\r
- Name_Model_Epsilon : constant Name_Id := N + 392;\r
- Name_Model_Mantissa : constant Name_Id := N + 393;\r
- Name_Model_Small : constant Name_Id := N + 394;\r
- Name_Modulus : constant Name_Id := N + 395;\r
- Name_Null_Parameter : constant Name_Id := N + 396; -- GNAT\r
- Name_Object_Size : constant Name_Id := N + 397; -- GNAT\r
- Name_Partition_ID : constant Name_Id := N + 398;\r
- Name_Passed_By_Reference : constant Name_Id := N + 399; -- GNAT\r
- Name_Pool_Address : constant Name_Id := N + 400;\r
- Name_Pos : constant Name_Id := N + 401;\r
- Name_Position : constant Name_Id := N + 402;\r
- Name_Range : constant Name_Id := N + 403;\r
- Name_Range_Length : constant Name_Id := N + 404; -- GNAT\r
- Name_Round : constant Name_Id := N + 405;\r
- Name_Safe_Emax : constant Name_Id := N + 406; -- Ada 83\r
- Name_Safe_First : constant Name_Id := N + 407;\r
- Name_Safe_Large : constant Name_Id := N + 408; -- Ada 83\r
- Name_Safe_Last : constant Name_Id := N + 409;\r
- Name_Safe_Small : constant Name_Id := N + 410; -- Ada 83\r
- Name_Scale : constant Name_Id := N + 411;\r
- Name_Scaling : constant Name_Id := N + 412;\r
- Name_Signed_Zeros : constant Name_Id := N + 413;\r
- Name_Size : constant Name_Id := N + 414;\r
- Name_Small : constant Name_Id := N + 415;\r
- Name_Storage_Size : constant Name_Id := N + 416;\r
- Name_Storage_Unit : constant Name_Id := N + 417; -- GNAT\r
- Name_Stream_Size : constant Name_Id := N + 418; -- Ada 05\r
- Name_Tag : constant Name_Id := N + 419;\r
- Name_Target_Name : constant Name_Id := N + 420; -- GNAT\r
- Name_Terminated : constant Name_Id := N + 421;\r
- Name_To_Address : constant Name_Id := N + 422; -- GNAT\r
- Name_Type_Class : constant Name_Id := N + 423; -- GNAT\r
- Name_UET_Address : constant Name_Id := N + 424; -- GNAT\r
- Name_Unbiased_Rounding : constant Name_Id := N + 425;\r
- Name_Unchecked_Access : constant Name_Id := N + 426;\r
- Name_Unconstrained_Array : constant Name_Id := N + 427;\r
- Name_Universal_Literal_String : constant Name_Id := N + 428; -- GNAT\r
- Name_Unrestricted_Access : constant Name_Id := N + 429; -- GNAT\r
- Name_VADS_Size : constant Name_Id := N + 430; -- GNAT\r
- Name_Val : constant Name_Id := N + 431;\r
- Name_Valid : constant Name_Id := N + 432;\r
- Name_Value_Size : constant Name_Id := N + 433; -- GNAT\r
- Name_Version : constant Name_Id := N + 434;\r
- Name_Wchar_T_Size : constant Name_Id := N + 435; -- GNAT\r
- Name_Wide_Wide_Width : constant Name_Id := N + 436; -- Ada 05\r
- Name_Wide_Width : constant Name_Id := N + 437;\r
- Name_Width : constant Name_Id := N + 438;\r
- Name_Word_Size : constant Name_Id := N + 439; -- GNAT\r
-\r
- -- Attributes that designate attributes returning renamable functions,\r
- -- i.e. functions that return other than a universal value and that\r
- -- have non-universal arguments.\r
-\r
- First_Renamable_Function_Attribute : constant Name_Id := N + 440;\r
- Name_Adjacent : constant Name_Id := N + 440;\r
- Name_Ceiling : constant Name_Id := N + 441;\r
- Name_Copy_Sign : constant Name_Id := N + 442;\r
- Name_Floor : constant Name_Id := N + 443;\r
- Name_Fraction : constant Name_Id := N + 444;\r
- Name_Image : constant Name_Id := N + 445;\r
- Name_Input : constant Name_Id := N + 446;\r
- Name_Machine : constant Name_Id := N + 447;\r
- Name_Max : constant Name_Id := N + 448;\r
- Name_Min : constant Name_Id := N + 449;\r
- Name_Model : constant Name_Id := N + 450;\r
- Name_Pred : constant Name_Id := N + 451;\r
- Name_Remainder : constant Name_Id := N + 452;\r
- Name_Rounding : constant Name_Id := N + 453;\r
- Name_Succ : constant Name_Id := N + 454;\r
- Name_Truncation : constant Name_Id := N + 455;\r
- Name_Value : constant Name_Id := N + 456;\r
- Name_Wide_Image : constant Name_Id := N + 457;\r
- Name_Wide_Wide_Image : constant Name_Id := N + 458;\r
- Name_Wide_Value : constant Name_Id := N + 459;\r
- Name_Wide_Wide_Value : constant Name_Id := N + 460;\r
- Last_Renamable_Function_Attribute : constant Name_Id := N + 460;\r
-\r
- -- Attributes that designate procedures\r
-\r
- First_Procedure_Attribute : constant Name_Id := N + 461;\r
- Name_Output : constant Name_Id := N + 461;\r
- Name_Read : constant Name_Id := N + 462;\r
- Name_Write : constant Name_Id := N + 463;\r
- Last_Procedure_Attribute : constant Name_Id := N + 463;\r
-\r
- -- Remaining attributes are ones that return entities\r
-\r
- First_Entity_Attribute_Name : constant Name_Id := N + 464;\r
- Name_Elab_Body : constant Name_Id := N + 464; -- GNAT\r
- Name_Elab_Spec : constant Name_Id := N + 465; -- GNAT\r
- Name_Storage_Pool : constant Name_Id := N + 466;\r
-\r
- -- These attributes are the ones that return types\r
-\r
- First_Type_Attribute_Name : constant Name_Id := N + 467;\r
- Name_Base : constant Name_Id := N + 467;\r
- Name_Class : constant Name_Id := N + 468;\r
- Last_Type_Attribute_Name : constant Name_Id := N + 468;\r
- Last_Entity_Attribute_Name : constant Name_Id := N + 468;\r
- Last_Attribute_Name : constant Name_Id := N + 468;\r
-\r
- -- Names of recognized locking policy identifiers\r
-\r
- -- Note: policies are identified by the first character of the\r
- -- name (e.g. C for Ceiling_Locking). If new policy names are added,\r
- -- the first character must be distinct.\r
-\r
- First_Locking_Policy_Name : constant Name_Id := N + 469;\r
- Name_Ceiling_Locking : constant Name_Id := N + 469;\r
- Name_Inheritance_Locking : constant Name_Id := N + 470;\r
- Last_Locking_Policy_Name : constant Name_Id := N + 470;\r
-\r
- -- Names of recognized queuing policy identifiers.\r
-\r
- -- Note: policies are identified by the first character of the\r
- -- name (e.g. F for FIFO_Queuing). If new policy names are added,\r
- -- the first character must be distinct.\r
-\r
- First_Queuing_Policy_Name : constant Name_Id := N + 471;\r
- Name_FIFO_Queuing : constant Name_Id := N + 471;\r
- Name_Priority_Queuing : constant Name_Id := N + 472;\r
- Last_Queuing_Policy_Name : constant Name_Id := N + 472;\r
-\r
- -- Names of recognized task dispatching policy identifiers\r
-\r
- -- Note: policies are identified by the first character of the\r
- -- name (e.g. F for FIFO_WIthinn_Priorities). If new policy names\r
- -- are added, the first character must be distinct.\r
-\r
- First_Task_Dispatching_Policy_Name : constant Name_Id := N + 473;\r
- Name_FIFO_Within_Priorities : constant Name_Id := N + 473;\r
- Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 473;\r
-\r
- -- Names of recognized checks for pragma Suppress\r
-\r
- First_Check_Name : constant Name_Id := N + 474;\r
- Name_Access_Check : constant Name_Id := N + 474;\r
- Name_Accessibility_Check : constant Name_Id := N + 475;\r
- Name_Discriminant_Check : constant Name_Id := N + 476;\r
- Name_Division_Check : constant Name_Id := N + 477;\r
- Name_Elaboration_Check : constant Name_Id := N + 478;\r
- Name_Index_Check : constant Name_Id := N + 479;\r
- Name_Length_Check : constant Name_Id := N + 480;\r
- Name_Overflow_Check : constant Name_Id := N + 481;\r
- Name_Range_Check : constant Name_Id := N + 482;\r
- Name_Storage_Check : constant Name_Id := N + 483;\r
- Name_Tag_Check : constant Name_Id := N + 484;\r
- Name_All_Checks : constant Name_Id := N + 485;\r
- Last_Check_Name : constant Name_Id := N + 485;\r
-\r
- -- Names corresponding to reserved keywords, excluding those already\r
- -- declared in the attribute list (Access, Delta, Digits, Mod, Range).\r
-\r
- Name_Abort : constant Name_Id := N + 486;\r
- Name_Abs : constant Name_Id := N + 487;\r
- Name_Accept : constant Name_Id := N + 488;\r
- Name_And : constant Name_Id := N + 489;\r
- Name_All : constant Name_Id := N + 490;\r
- Name_Array : constant Name_Id := N + 491;\r
- Name_At : constant Name_Id := N + 492;\r
- Name_Begin : constant Name_Id := N + 493;\r
- Name_Body : constant Name_Id := N + 494;\r
- Name_Case : constant Name_Id := N + 495;\r
- Name_Constant : constant Name_Id := N + 496;\r
- Name_Declare : constant Name_Id := N + 497;\r
- Name_Delay : constant Name_Id := N + 498;\r
- Name_Do : constant Name_Id := N + 499;\r
- Name_Else : constant Name_Id := N + 500;\r
- Name_Elsif : constant Name_Id := N + 501;\r
- Name_End : constant Name_Id := N + 502;\r
- Name_Entry : constant Name_Id := N + 503;\r
- Name_Exception : constant Name_Id := N + 504;\r
- Name_Exit : constant Name_Id := N + 505;\r
- Name_For : constant Name_Id := N + 506;\r
- Name_Function : constant Name_Id := N + 507;\r
- Name_Generic : constant Name_Id := N + 508;\r
- Name_Goto : constant Name_Id := N + 509;\r
- Name_If : constant Name_Id := N + 510;\r
- Name_In : constant Name_Id := N + 511;\r
- Name_Is : constant Name_Id := N + 512;\r
- Name_Limited : constant Name_Id := N + 513;\r
- Name_Loop : constant Name_Id := N + 514;\r
- Name_New : constant Name_Id := N + 515;\r
- Name_Not : constant Name_Id := N + 516;\r
- Name_Null : constant Name_Id := N + 517;\r
- Name_Of : constant Name_Id := N + 518;\r
- Name_Or : constant Name_Id := N + 519;\r
- Name_Others : constant Name_Id := N + 520;\r
- Name_Out : constant Name_Id := N + 521;\r
- Name_Package : constant Name_Id := N + 522;\r
- Name_Pragma : constant Name_Id := N + 523;\r
- Name_Private : constant Name_Id := N + 524;\r
- Name_Procedure : constant Name_Id := N + 525;\r
- Name_Raise : constant Name_Id := N + 526;\r
- Name_Record : constant Name_Id := N + 527;\r
- Name_Rem : constant Name_Id := N + 528;\r
- Name_Renames : constant Name_Id := N + 529;\r
- Name_Return : constant Name_Id := N + 530;\r
- Name_Reverse : constant Name_Id := N + 531;\r
- Name_Select : constant Name_Id := N + 532;\r
- Name_Separate : constant Name_Id := N + 533;\r
- Name_Subtype : constant Name_Id := N + 534;\r
- Name_Task : constant Name_Id := N + 535;\r
- Name_Terminate : constant Name_Id := N + 536;\r
- Name_Then : constant Name_Id := N + 537;\r
- Name_Type : constant Name_Id := N + 538;\r
- Name_Use : constant Name_Id := N + 539;\r
- Name_When : constant Name_Id := N + 540;\r
- Name_While : constant Name_Id := N + 541;\r
- Name_With : constant Name_Id := N + 542;\r
- Name_Xor : constant Name_Id := N + 543;\r
-\r
- -- Names of intrinsic subprograms\r
-\r
- -- Note: Asm is missing from this list, since Asm is a legitimate\r
- -- convention name. So is To_Adress, which is a GNAT attribute.\r
-\r
- First_Intrinsic_Name : constant Name_Id := N + 544;\r
- Name_Divide : constant Name_Id := N + 544;\r
- Name_Enclosing_Entity : constant Name_Id := N + 545;\r
- Name_Exception_Information : constant Name_Id := N + 546;\r
- Name_Exception_Message : constant Name_Id := N + 547;\r
- Name_Exception_Name : constant Name_Id := N + 548;\r
- Name_File : constant Name_Id := N + 549;\r
- Name_Import_Address : constant Name_Id := N + 550;\r
- Name_Import_Largest_Value : constant Name_Id := N + 551;\r
- Name_Import_Value : constant Name_Id := N + 552;\r
- Name_Is_Negative : constant Name_Id := N + 553;\r
- Name_Line : constant Name_Id := N + 554;\r
- Name_Rotate_Left : constant Name_Id := N + 555;\r
- Name_Rotate_Right : constant Name_Id := N + 556;\r
- Name_Shift_Left : constant Name_Id := N + 557;\r
- Name_Shift_Right : constant Name_Id := N + 558;\r
- Name_Shift_Right_Arithmetic : constant Name_Id := N + 559;\r
- Name_Source_Location : constant Name_Id := N + 560;\r
- Name_Unchecked_Conversion : constant Name_Id := N + 561;\r
- Name_Unchecked_Deallocation : constant Name_Id := N + 562;\r
- Name_To_Pointer : constant Name_Id := N + 563;\r
- Last_Intrinsic_Name : constant Name_Id := N + 563;\r
-\r
- -- Reserved words used only in Ada 95\r
-\r
- First_95_Reserved_Word : constant Name_Id := N + 564;\r
- Name_Abstract : constant Name_Id := N + 564;\r
- Name_Aliased : constant Name_Id := N + 565;\r
- Name_Protected : constant Name_Id := N + 566;\r
- Name_Until : constant Name_Id := N + 567;\r
- Name_Requeue : constant Name_Id := N + 568;\r
- Name_Tagged : constant Name_Id := N + 569;\r
- Last_95_Reserved_Word : constant Name_Id := N + 569;\r
-\r
- subtype Ada_95_Reserved_Words is\r
- Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;\r
-\r
- -- Miscellaneous names used in semantic checking\r
-\r
- Name_Raise_Exception : constant Name_Id := N + 570;\r
-\r
- -- Additional reserved words and identifiers used in GNAT Project Files\r
- -- Note that Name_External is already previously declared\r
-\r
- Name_Ada_Roots : constant Name_Id := N + 571;\r
- Name_Binder : constant Name_Id := N + 572;\r
- Name_Binder_Driver : constant Name_Id := N + 573;\r
- Name_Body_Suffix : constant Name_Id := N + 574;\r
- Name_Builder : constant Name_Id := N + 575;\r
- Name_Compiler : constant Name_Id := N + 576;\r
- Name_Compiler_Driver : constant Name_Id := N + 577;\r
- Name_Compiler_Kind : constant Name_Id := N + 578;\r
- Name_Compute_Dependency : constant Name_Id := N + 579;\r
- Name_Cross_Reference : constant Name_Id := N + 580;\r
- Name_Default_Linker : constant Name_Id := N + 581;\r
- Name_Default_Switches : constant Name_Id := N + 582;\r
- Name_Dependency_Option : constant Name_Id := N + 583;\r
- Name_Exec_Dir : constant Name_Id := N + 584;\r
- Name_Executable : constant Name_Id := N + 585;\r
- Name_Executable_Suffix : constant Name_Id := N + 586;\r
- Name_Extends : constant Name_Id := N + 587;\r
- Name_Externally_Built : constant Name_Id := N + 588;\r
- Name_Finder : constant Name_Id := N + 589;\r
- Name_Global_Configuration_Pragmas : constant Name_Id := N + 590;\r
- Name_Gnatls : constant Name_Id := N + 591;\r
- Name_Gnatstub : constant Name_Id := N + 592;\r
- Name_Implementation : constant Name_Id := N + 593;\r
- Name_Implementation_Exceptions : constant Name_Id := N + 594;\r
- Name_Implementation_Suffix : constant Name_Id := N + 595;\r
- Name_Include_Option : constant Name_Id := N + 596;\r
- Name_Language_Processing : constant Name_Id := N + 597;\r
- Name_Languages : constant Name_Id := N + 598;\r
- Name_Library_Dir : constant Name_Id := N + 599;\r
- Name_Library_Auto_Init : constant Name_Id := N + 600;\r
- Name_Library_GCC : constant Name_Id := N + 601;\r
- Name_Library_Interface : constant Name_Id := N + 602;\r
- Name_Library_Kind : constant Name_Id := N + 603;\r
- Name_Library_Name : constant Name_Id := N + 604;\r
- Name_Library_Options : constant Name_Id := N + 605;\r
- Name_Library_Reference_Symbol_File : constant Name_Id := N + 606;\r
- Name_Library_Src_Dir : constant Name_Id := N + 607;\r
- Name_Library_Symbol_File : constant Name_Id := N + 608;\r
- Name_Library_Symbol_Policy : constant Name_Id := N + 609;\r
- Name_Library_Version : constant Name_Id := N + 610;\r
- Name_Linker : constant Name_Id := N + 611;\r
- Name_Local_Configuration_Pragmas : constant Name_Id := N + 612;\r
- Name_Locally_Removed_Files : constant Name_Id := N + 613;\r
- Name_Metrics : constant Name_Id := N + 614;\r
- Name_Naming : constant Name_Id := N + 615;\r
- Name_Object_Dir : constant Name_Id := N + 616;\r
- Name_Pretty_Printer : constant Name_Id := N + 617;\r
- Name_Project : constant Name_Id := N + 618;\r
- Name_Separate_Suffix : constant Name_Id := N + 619;\r
- Name_Source_Dirs : constant Name_Id := N + 620;\r
- Name_Source_Files : constant Name_Id := N + 621;\r
- Name_Source_List_File : constant Name_Id := N + 622;\r
- Name_Spec : constant Name_Id := N + 623;\r
- Name_Spec_Suffix : constant Name_Id := N + 624;\r
- Name_Specification : constant Name_Id := N + 625;\r
- Name_Specification_Exceptions : constant Name_Id := N + 626;\r
- Name_Specification_Suffix : constant Name_Id := N + 627;\r
- Name_Switches : constant Name_Id := N + 628;\r
-\r
- -- Other miscellaneous names used in front end\r
-\r
- Name_Unaligned_Valid : constant Name_Id := N + 629;\r
-\r
- -- ----------------------------------------------------------------\r
- First_2005_Reserved_Word : constant Name_Id := N + 630;\r
- Name_Interface : constant Name_Id := N + 630;\r
- Name_Overriding : constant Name_Id := N + 631;\r
- Name_Synchronized : constant Name_Id := N + 632;\r
- Last_2005_Reserved_Word : constant Name_Id := N + 632;\r
-\r
- subtype Ada_2005_Reserved_Words is\r
- Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;\r
-\r
- -- Mark last defined name for consistency check in Snames body\r
-\r
- Last_Predefined_Name : constant Name_Id := N + 632;\r
-\r
- subtype Any_Operator_Name is Name_Id range\r
- First_Operator_Name .. Last_Operator_Name;\r
-\r
- ------------------------------\r
- -- Attribute ID Definitions --\r
- ------------------------------\r
-\r
- type Attribute_Id is (\r
- Attribute_Abort_Signal,\r
- Attribute_Access,\r
- Attribute_Address,\r
- Attribute_Address_Size,\r
- Attribute_Aft,\r
- Attribute_Alignment,\r
- Attribute_Asm_Input,\r
- Attribute_Asm_Output,\r
- Attribute_AST_Entry,\r
- Attribute_Bit,\r
- Attribute_Bit_Order,\r
- Attribute_Bit_Position,\r
- Attribute_Body_Version,\r
- Attribute_Callable,\r
- Attribute_Caller,\r
- Attribute_Code_Address,\r
- Attribute_Component_Size,\r
- Attribute_Compose,\r
- Attribute_Constrained,\r
- Attribute_Count,\r
- Attribute_Default_Bit_Order,\r
- Attribute_Definite,\r
- Attribute_Delta,\r
- Attribute_Denorm,\r
- Attribute_Digits,\r
- Attribute_Elaborated,\r
- Attribute_Emax,\r
- Attribute_Enum_Rep,\r
- Attribute_Epsilon,\r
- Attribute_Exponent,\r
- Attribute_External_Tag,\r
- Attribute_First,\r
- Attribute_First_Bit,\r
- Attribute_Fixed_Value,\r
- Attribute_Fore,\r
- Attribute_Has_Access_Values,\r
- Attribute_Has_Discriminants,\r
- Attribute_Identity,\r
- Attribute_Img,\r
- Attribute_Integer_Value,\r
- Attribute_Large,\r
- Attribute_Last,\r
- Attribute_Last_Bit,\r
- Attribute_Leading_Part,\r
- Attribute_Length,\r
- Attribute_Machine_Emax,\r
- Attribute_Machine_Emin,\r
- Attribute_Machine_Mantissa,\r
- Attribute_Machine_Overflows,\r
- Attribute_Machine_Radix,\r
- Attribute_Machine_Rounds,\r
- Attribute_Machine_Size,\r
- Attribute_Mantissa,\r
- Attribute_Max_Size_In_Storage_Elements,\r
- Attribute_Maximum_Alignment,\r
- Attribute_Mechanism_Code,\r
- Attribute_Mod,\r
- Attribute_Model_Emin,\r
- Attribute_Model_Epsilon,\r
- Attribute_Model_Mantissa,\r
- Attribute_Model_Small,\r
- Attribute_Modulus,\r
- Attribute_Null_Parameter,\r
- Attribute_Object_Size,\r
- Attribute_Partition_ID,\r
- Attribute_Passed_By_Reference,\r
- Attribute_Pool_Address,\r
- Attribute_Pos,\r
- Attribute_Position,\r
- Attribute_Range,\r
- Attribute_Range_Length,\r
- Attribute_Round,\r
- Attribute_Safe_Emax,\r
- Attribute_Safe_First,\r
- Attribute_Safe_Large,\r
- Attribute_Safe_Last,\r
- Attribute_Safe_Small,\r
- Attribute_Scale,\r
- Attribute_Scaling,\r
- Attribute_Signed_Zeros,\r
- Attribute_Size,\r
- Attribute_Small,\r
- Attribute_Storage_Size,\r
- Attribute_Storage_Unit,\r
- Attribute_Stream_Size,\r
- Attribute_Tag,\r
- Attribute_Target_Name,\r
- Attribute_Terminated,\r
- Attribute_To_Address,\r
- Attribute_Type_Class,\r
- Attribute_UET_Address,\r
- Attribute_Unbiased_Rounding,\r
- Attribute_Unchecked_Access,\r
- Attribute_Unconstrained_Array,\r
- Attribute_Universal_Literal_String,\r
- Attribute_Unrestricted_Access,\r
- Attribute_VADS_Size,\r
- Attribute_Val,\r
- Attribute_Valid,\r
- Attribute_Value_Size,\r
- Attribute_Version,\r
- Attribute_Wchar_T_Size,\r
- Attribute_Wide_Wide_Width,\r
- Attribute_Wide_Width,\r
- Attribute_Width,\r
- Attribute_Word_Size,\r
-\r
- -- Attributes designating renamable functions\r
-\r
- Attribute_Adjacent,\r
- Attribute_Ceiling,\r
- Attribute_Copy_Sign,\r
- Attribute_Floor,\r
- Attribute_Fraction,\r
- Attribute_Image,\r
- Attribute_Input,\r
- Attribute_Machine,\r
- Attribute_Max,\r
- Attribute_Min,\r
- Attribute_Model,\r
- Attribute_Pred,\r
- Attribute_Remainder,\r
- Attribute_Rounding,\r
- Attribute_Succ,\r
- Attribute_Truncation,\r
- Attribute_Value,\r
- Attribute_Wide_Image,\r
- Attribute_Wide_Wide_Image,\r
- Attribute_Wide_Value,\r
- Attribute_Wide_Wide_Value,\r
-\r
- -- Attributes designating procedures\r
-\r
- Attribute_Output,\r
- Attribute_Read,\r
- Attribute_Write,\r
-\r
- -- Entity attributes (includes type attributes)\r
-\r
- Attribute_Elab_Body,\r
- Attribute_Elab_Spec,\r
- Attribute_Storage_Pool,\r
-\r
- -- Type attributes\r
-\r
- Attribute_Base,\r
- Attribute_Class);\r
-\r
- ------------------------------------\r
- -- Convention Name ID Definitions --\r
- ------------------------------------\r
-\r
- type Convention_Id is (\r
-\r
- -- The conventions that are defined by the RM come first\r
-\r
- Convention_Ada,\r
- Convention_Intrinsic,\r
- Convention_Entry,\r
- Convention_Protected,\r
-\r
- -- The remaining conventions are foreign language conventions\r
-\r
- Convention_Assembler, -- also Asm, Assembly\r
- Convention_C, -- also Default, External\r
- Convention_COBOL,\r
- Convention_CPP,\r
- Convention_Fortran,\r
- Convention_Java,\r
- Convention_Stdcall, -- also DLL, Win32\r
- Convention_Stubbed);\r
-\r
- -- Note: Convention C_Pass_By_Copy is allowed only for record\r
- -- types (where it is treated like C except that the appropriate\r
- -- flag is set in the record type). Recognizion of this convention\r
- -- is specially handled in Sem_Prag.\r
-\r
- for Convention_Id'Size use 8;\r
- -- Plenty of space for expansion\r
-\r
- subtype Foreign_Convention is\r
- Convention_Id range Convention_Assembler .. Convention_Stdcall;\r
-\r
- -----------------------------------\r
- -- Locking Policy ID Definitions --\r
- -----------------------------------\r
-\r
- type Locking_Policy_Id is (\r
- Locking_Policy_Inheritance_Locking,\r
- Locking_Policy_Ceiling_Locking);\r
-\r
- ---------------------------\r
- -- Pragma ID Definitions --\r
- ---------------------------\r
-\r
- type Pragma_Id is (\r
-\r
- -- Configuration pragmas\r
-\r
- Pragma_Ada_83,\r
- Pragma_Ada_95,\r
- Pragma_Ada_05,\r
- Pragma_C_Pass_By_Copy,\r
- Pragma_Compile_Time_Warning,\r
- Pragma_Component_Alignment,\r
- Pragma_Convention_Identifier,\r
- Pragma_Detect_Blocking,\r
- Pragma_Discard_Names,\r
- Pragma_Elaboration_Checks,\r
- Pragma_Eliminate,\r
- Pragma_Explicit_Overriding,\r
- Pragma_Extend_System,\r
- Pragma_Extensions_Allowed,\r
- Pragma_External_Name_Casing,\r
- Pragma_Float_Representation,\r
- Pragma_Initialize_Scalars,\r
- Pragma_Interrupt_State,\r
- Pragma_License,\r
- Pragma_Locking_Policy,\r
- Pragma_Long_Float,\r
- Pragma_No_Run_Time,\r
- Pragma_No_Strict_Aliasing,\r
- Pragma_Normalize_Scalars,\r
- Pragma_Polling,\r
- Pragma_Persistent_Data,\r
- Pragma_Persistent_Object,\r
- Pragma_Profile,\r
- Pragma_Profile_Warnings,\r
- Pragma_Propagate_Exceptions,\r
- Pragma_Queuing_Policy,\r
- Pragma_Ravenscar,\r
- Pragma_Restricted_Run_Time,\r
- Pragma_Restrictions,\r
- Pragma_Restriction_Warnings,\r
- Pragma_Reviewable,\r
- Pragma_Source_File_Name,\r
- Pragma_Source_File_Name_Project,\r
- Pragma_Style_Checks,\r
- Pragma_Suppress,\r
- Pragma_Suppress_Exception_Locations,\r
- Pragma_Task_Dispatching_Policy,\r
- Pragma_Universal_Data,\r
- Pragma_Unsuppress,\r
- Pragma_Use_VADS_Size,\r
- Pragma_Validity_Checks,\r
- Pragma_Warnings,\r
-\r
- -- Remaining (non-configuration) pragmas\r
-\r
- Pragma_Abort_Defer,\r
- Pragma_All_Calls_Remote,\r
- Pragma_Annotate,\r
- Pragma_Assert,\r
- Pragma_Asynchronous,\r
- Pragma_Atomic,\r
- Pragma_Atomic_Components,\r
- Pragma_Attach_Handler,\r
- Pragma_Comment,\r
- Pragma_Common_Object,\r
- Pragma_Complex_Representation,\r
- Pragma_Controlled,\r
- Pragma_Convention,\r
- Pragma_CPP_Class,\r
- Pragma_CPP_Constructor,\r
- Pragma_CPP_Virtual,\r
- Pragma_CPP_Vtable,\r
- Pragma_Debug,\r
- Pragma_Elaborate,\r
- Pragma_Elaborate_All,\r
- Pragma_Elaborate_Body,\r
- Pragma_Export,\r
- Pragma_Export_Exception,\r
- Pragma_Export_Function,\r
- Pragma_Export_Object,\r
- Pragma_Export_Procedure,\r
- Pragma_Export_Value,\r
- Pragma_Export_Valued_Procedure,\r
- Pragma_External,\r
- Pragma_Finalize_Storage_Only,\r
- Pragma_Ident,\r
- Pragma_Import,\r
- Pragma_Import_Exception,\r
- Pragma_Import_Function,\r
- Pragma_Import_Object,\r
- Pragma_Import_Procedure,\r
- Pragma_Import_Valued_Procedure,\r
- Pragma_Inline,\r
- Pragma_Inline_Always,\r
- Pragma_Inline_Generic,\r
- Pragma_Inspection_Point,\r
- Pragma_Interface_Name,\r
- Pragma_Interrupt_Handler,\r
- Pragma_Interrupt_Priority,\r
- Pragma_Java_Constructor,\r
- Pragma_Java_Interface,\r
- Pragma_Keep_Names,\r
- Pragma_Link_With,\r
- Pragma_Linker_Alias,\r
- Pragma_Linker_Options,\r
- Pragma_Linker_Section,\r
- Pragma_List,\r
- Pragma_Machine_Attribute,\r
- Pragma_Main,\r
- Pragma_Main_Storage,\r
- Pragma_Memory_Size,\r
- Pragma_No_Return,\r
- Pragma_Obsolescent,\r
- Pragma_Optimize,\r
- Pragma_Optional_Overriding,\r
- Pragma_Pack,\r
- Pragma_Page,\r
- Pragma_Passive,\r
- Pragma_Preelaborate,\r
- Pragma_Priority,\r
- Pragma_Psect_Object,\r
- Pragma_Pure,\r
- Pragma_Pure_Function,\r
- Pragma_Remote_Call_Interface,\r
- Pragma_Remote_Types,\r
- Pragma_Share_Generic,\r
- Pragma_Shared,\r
- Pragma_Shared_Passive,\r
- Pragma_Source_Reference,\r
- Pragma_Stream_Convert,\r
- Pragma_Subtitle,\r
- Pragma_Suppress_All,\r
- Pragma_Suppress_Debug_Info,\r
- Pragma_Suppress_Initialization,\r
- Pragma_System_Name,\r
- Pragma_Task_Info,\r
- Pragma_Task_Name,\r
- Pragma_Task_Storage,\r
- Pragma_Thread_Body,\r
- Pragma_Time_Slice,\r
- Pragma_Title,\r
- Pragma_Unchecked_Union,\r
- Pragma_Unimplemented_Unit,\r
- Pragma_Unreferenced,\r
- Pragma_Unreserve_All_Interrupts,\r
- Pragma_Volatile,\r
- Pragma_Volatile_Components,\r
- Pragma_Weak_External,\r
-\r
- -- The following pragmas are on their own, out of order, because of\r
- -- the special processing required to deal with the fact that their\r
- -- names match existing attribute names.\r
-\r
- Pragma_AST_Entry,\r
- Pragma_Interface,\r
- Pragma_Storage_Size,\r
- Pragma_Storage_Unit,\r
-\r
- -- The value to represent an unknown or unrecognized pragma\r
-\r
- Unknown_Pragma);\r
-\r
- -----------------------------------\r
- -- Queuing Policy ID definitions --\r
- -----------------------------------\r
-\r
- type Queuing_Policy_Id is (\r
- Queuing_Policy_FIFO_Queuing,\r
- Queuing_Policy_Priority_Queuing);\r
-\r
- --------------------------------------------\r
- -- Task Dispatching Policy ID definitions --\r
- --------------------------------------------\r
-\r
- type Task_Dispatching_Policy_Id is (\r
- Task_Dispatching_FIFO_Within_Priorities);\r
- -- Id values used to identify task dispatching policies\r
-\r
- -----------------\r
- -- Subprograms --\r
- -----------------\r
-\r
- procedure Initialize;\r
- -- Called to initialize the preset names in the names table.\r
-\r
- function Is_Attribute_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized attribute\r
-\r
- function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized entity attribute,\r
- -- i.e. an attribute reference that returns an entity.\r
-\r
- function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized attribute that\r
- -- designates a procedure (and can therefore appear as a statement).\r
-\r
- function Is_Function_Attribute_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized attribute\r
- -- that designates a renameable function, and can therefore appear in\r
- -- a renaming statement. Note that not all attributes designating\r
- -- functions are renamable, in particular, thos returning a universal\r
- -- value cannot be renamed.\r
-\r
- function Is_Type_Attribute_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized type attribute,\r
- -- i.e. an attribute reference that returns a type\r
-\r
- function Is_Check_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized suppress check\r
- -- as required by pragma Suppress.\r
-\r
- function Is_Convention_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of one of the recognized\r
- -- language conventions, as required by pragma Convention, Import,\r
- -- Export, Interface. Returns True if so. Also returns True for a\r
- -- name that has been specified by a Convention_Identifier pragma.\r
- -- If neither case holds, returns False.\r
-\r
- function Is_Locking_Policy_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized locking policy\r
-\r
- function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of an operator symbol\r
-\r
- function Is_Pragma_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized pragma. Note\r
- -- that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized\r
- -- as pragmas by this function even though their names are separate from\r
- -- the other pragma names.\r
-\r
- function Is_Queuing_Policy_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized queuing policy\r
-\r
- function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean;\r
- -- Test to see if the name N is the name of a recognized task\r
- -- dispatching policy.\r
-\r
- function Get_Attribute_Id (N : Name_Id) return Attribute_Id;\r
- -- Returns Id of attribute corresponding to given name. It is an error to\r
- -- call this function with a name that is not the name of a attribute.\r
-\r
- function Get_Convention_Id (N : Name_Id) return Convention_Id;\r
- -- Returns Id of language convention corresponding to given name. It is an\r
- -- to call this function with a name that is not the name of a convention,\r
- -- or one previously given in a call to Record_Convention_Identifier.\r
-\r
- function Get_Check_Id (N : Name_Id) return Check_Id;\r
- -- Returns Id of suppress check corresponding to given name. It is an error\r
- -- to call this function with a name that is not the name of a check.\r
-\r
- function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id;\r
- -- Returns Id of locking policy corresponding to given name. It is an error\r
- -- to call this function with a name that is not the name of a check.\r
-\r
- function Get_Pragma_Id (N : Name_Id) return Pragma_Id;\r
- -- Returns Id of pragma corresponding to given name. Returns Unknown_Pragma\r
- -- if N is not a name of a known (Ada defined or GNAT-specific) pragma.\r
- -- Note that the function also works correctly for names of pragmas that\r
- -- are not in the main list of pragma Names (AST_Entry, Storage_Size, and\r
- -- Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size).\r
-\r
- function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;\r
- -- Returns Id of queuing policy corresponding to given name. It is an error\r
- -- to call this function with a name that is not the name of a check.\r
-\r
- function Get_Task_Dispatching_Policy_Id\r
- (N : Name_Id)\r
- return Task_Dispatching_Policy_Id;\r
- -- Returns Id of task dispatching policy corresponding to given name.\r
- -- It is an error to call this function with a name that is not the\r
- -- name of a check.\r
-\r
- procedure Record_Convention_Identifier\r
- (Id : Name_Id;\r
- Convention : Convention_Id);\r
- -- A call to this procedure, resulting from an occurrence of a pragma\r
- -- Convention_Identifier, records that from now on an occurrence of\r
- -- Id will be recognized as a name for the specified convention.\r
-\r
-private\r
- pragma Inline (Is_Attribute_Name);\r
- pragma Inline (Is_Entity_Attribute_Name);\r
- pragma Inline (Is_Type_Attribute_Name);\r
- pragma Inline (Is_Check_Name);\r
- pragma Inline (Is_Locking_Policy_Name);\r
- pragma Inline (Is_Operator_Symbol_Name);\r
- pragma Inline (Is_Queuing_Policy_Name);\r
- pragma Inline (Is_Pragma_Name);\r
- pragma Inline (Is_Task_Dispatching_Policy_Name);\r
-\r
-end Snames;\r
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S N A M E S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2005, 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- --
+-- 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 Types; use Types;
+
+package Snames is
+
+-- This package contains definitions of standard names (i.e. entries in the
+-- Names table) that are used throughout the GNAT compiler). It also contains
+-- the definitions of some enumeration types whose definitions are tied to
+-- the order of these preset names.
+
+-- WARNING: There is a C file, a-snames.h which duplicates some of the
+-- definitions in this file and must be kept properly synchronized.
+
+ ------------------
+ -- Preset Names --
+ ------------------
+
+ -- The following are preset entries in the names table, which are
+ -- entered at the start of every compilation for easy access. Note
+ -- that the order of initialization of these names in the body must
+ -- be coordinated with the order of names in this table.
+
+ -- Note: a name may not appear more than once in the following list.
+ -- If additional pragmas or attributes are introduced which might
+ -- otherwise cause a duplicate, then list it only once in this table,
+ -- and adjust the definition of the functions for testing for pragma
+ -- names and attribute names, and returning their ID values. Of course
+ -- everything is simpler if no such duplications occur!
+
+ -- First we have the one character names used to optimize the lookup
+ -- process for one character identifiers (to avoid the hashing in this
+ -- case) There are a full 256 of these, but only the entries for lower
+ -- case and upper case letters have identifiers
+
+ -- The lower case letter entries are used for one character identifiers
+ -- appearing in the source, for example in pragma Interface (C).
+
+ Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a');
+ Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b');
+ Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c');
+ Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d');
+ Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e');
+ Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f');
+ Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g');
+ Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h');
+ Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i');
+ Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j');
+ Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k');
+ Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l');
+ Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m');
+ Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n');
+ Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o');
+ Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p');
+ Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q');
+ Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r');
+ Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s');
+ Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t');
+ Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u');
+ Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v');
+ Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w');
+ Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x');
+ Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y');
+ Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z');
+
+ -- The upper case letter entries are used by expander code for local
+ -- variables that do not require unique names (e.g. formal parameter
+ -- names in constructed procedures)
+
+ Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A');
+ Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B');
+ Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C');
+ Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D');
+ Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E');
+ Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F');
+ Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G');
+ Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H');
+ Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I');
+ Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J');
+ Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K');
+ Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L');
+ Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M');
+ Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N');
+ Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O');
+ Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P');
+ Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q');
+ Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R');
+ Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S');
+ Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T');
+ Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U');
+ Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V');
+ Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W');
+ Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X');
+ Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
+ Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
+
+ -- Note: the following table is read by the utility program XSNAMES and
+ -- its format should not be changed without coordinating with this program.
+
+ N : constant Name_Id := First_Name_Id + 256;
+ -- Synonym used in standard name definitions
+
+ -- Some names that are used by gigi, and whose definitions are reflected
+ -- in the C header file a-snames.h. They are placed at the start so that
+ -- the need to modify a-snames.h is minimized.
+
+ Name_uParent : constant Name_Id := N + 000;
+ Name_uTag : constant Name_Id := N + 001;
+ Name_Off : constant Name_Id := N + 002;
+ Name_Space : constant Name_Id := N + 003;
+ Name_Time : constant Name_Id := N + 004;
+
+ -- Some special names used by the expander. Note that the lower case u's
+ -- at the start of these names get translated to extra underscores. These
+ -- names are only referenced internally by expander generated code.
+
+ Name_uAbort_Signal : constant Name_Id := N + 005;
+ Name_uAlignment : constant Name_Id := N + 006;
+ Name_uAssign : constant Name_Id := N + 007;
+ Name_uATCB : constant Name_Id := N + 008;
+ Name_uChain : constant Name_Id := N + 009;
+ Name_uClean : constant Name_Id := N + 010;
+ Name_uController : constant Name_Id := N + 011;
+ Name_uEntry_Bodies : constant Name_Id := N + 012;
+ Name_uExpunge : constant Name_Id := N + 013;
+ Name_uFinal_List : constant Name_Id := N + 014;
+ Name_uIdepth : constant Name_Id := N + 015;
+ Name_uInit : constant Name_Id := N + 016;
+ Name_uLocal_Final_List : constant Name_Id := N + 017;
+ Name_uMaster : constant Name_Id := N + 018;
+ Name_uObject : constant Name_Id := N + 019;
+ Name_uPriority : constant Name_Id := N + 020;
+ Name_uProcess_ATSD : constant Name_Id := N + 021;
+ Name_uSecondary_Stack : constant Name_Id := N + 022;
+ Name_uService : constant Name_Id := N + 023;
+ Name_uSize : constant Name_Id := N + 024;
+ Name_uStack : constant Name_Id := N + 025;
+ Name_uTags : constant Name_Id := N + 026;
+ Name_uTask : constant Name_Id := N + 027;
+ Name_uTask_Id : constant Name_Id := N + 028;
+ Name_uTask_Info : constant Name_Id := N + 029;
+ Name_uTask_Name : constant Name_Id := N + 030;
+ Name_uTrace_Sp : constant Name_Id := N + 031;
+
+ -- Names of routines in Ada.Finalization, needed by expander
+
+ Name_Initialize : constant Name_Id := N + 032;
+ Name_Adjust : constant Name_Id := N + 033;
+ Name_Finalize : constant Name_Id := N + 034;
+
+ -- Names of fields declared in System.Finalization_Implementation,
+ -- needed by the expander when generating code for finalization.
+
+ Name_Next : constant Name_Id := N + 035;
+ Name_Prev : constant Name_Id := N + 036;
+
+ -- Names of TSS routines for implementation of DSA over PolyORB
+
+ Name_uTypeCode : constant Name_Id := N + 037;
+ Name_uFrom_Any : constant Name_Id := N + 038;
+ Name_uTo_Any : constant Name_Id := N + 039;
+
+ -- Names of allocation routines, also needed by expander
+
+ Name_Allocate : constant Name_Id := N + 040;
+ Name_Deallocate : constant Name_Id := N + 041;
+ Name_Dereference : constant Name_Id := N + 042;
+
+ -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)
+
+ First_Text_IO_Package : constant Name_Id := N + 043;
+ Name_Decimal_IO : constant Name_Id := N + 043;
+ Name_Enumeration_IO : constant Name_Id := N + 044;
+ Name_Fixed_IO : constant Name_Id := N + 045;
+ Name_Float_IO : constant Name_Id := N + 046;
+ Name_Integer_IO : constant Name_Id := N + 047;
+ Name_Modular_IO : constant Name_Id := N + 048;
+ Last_Text_IO_Package : constant Name_Id := N + 048;
+
+ subtype Text_IO_Package_Name is Name_Id
+ range First_Text_IO_Package .. Last_Text_IO_Package;
+
+ -- Some miscellaneous names used for error detection/recovery
+
+ Name_Const : constant Name_Id := N + 049;
+ Name_Error : constant Name_Id := N + 050;
+ Name_Go : constant Name_Id := N + 051;
+ Name_Put : constant Name_Id := N + 052;
+ Name_Put_Line : constant Name_Id := N + 053;
+ Name_To : constant Name_Id := N + 054;
+
+ -- Names for packages that are treated specially by the compiler
+
+ Name_Finalization : constant Name_Id := N + 055;
+ Name_Finalization_Root : constant Name_Id := N + 056;
+ Name_Interfaces : constant Name_Id := N + 057;
+ Name_Standard : constant Name_Id := N + 058;
+ Name_System : constant Name_Id := N + 059;
+ Name_Text_IO : constant Name_Id := N + 060;
+ Name_Wide_Text_IO : constant Name_Id := N + 061;
+ Name_Wide_Wide_Text_IO : constant Name_Id := N + 062;
+
+ -- Names of implementations of the distributed systems annex
+
+ First_PCS_Name : constant Name_Id := N + 063;
+ Name_No_DSA : constant Name_Id := N + 063;
+ Name_GARLIC_DSA : constant Name_Id := N + 064;
+ Name_PolyORB_DSA : constant Name_Id := N + 065;
+ Last_PCS_Name : constant Name_Id := N + 065;
+
+ subtype PCS_Names is Name_Id
+ range First_PCS_Name .. Last_PCS_Name;
+
+ -- Names of identifiers used in expanding distribution stubs
+
+ Name_Addr : constant Name_Id := N + 066;
+ Name_Async : constant Name_Id := N + 067;
+ Name_Get_Active_Partition_ID : constant Name_Id := N + 068;
+ Name_Get_RCI_Package_Receiver : constant Name_Id := N + 069;
+ Name_Get_RCI_Package_Ref : constant Name_Id := N + 070;
+ Name_Origin : constant Name_Id := N + 071;
+ Name_Params : constant Name_Id := N + 072;
+ Name_Partition : constant Name_Id := N + 073;
+ Name_Partition_Interface : constant Name_Id := N + 074;
+ Name_Ras : constant Name_Id := N + 075;
+ Name_Call : constant Name_Id := N + 076;
+ Name_RCI_Name : constant Name_Id := N + 077;
+ Name_Receiver : constant Name_Id := N + 078;
+ Name_Result : constant Name_Id := N + 079;
+ Name_Rpc : constant Name_Id := N + 080;
+ Name_Subp_Id : constant Name_Id := N + 081;
+ Name_Operation : constant Name_Id := N + 082;
+ Name_Argument : constant Name_Id := N + 083;
+ Name_Arg_Modes : constant Name_Id := N + 084;
+ Name_Handler : constant Name_Id := N + 085;
+ Name_Target : constant Name_Id := N + 086;
+ Name_Req : constant Name_Id := N + 087;
+ Name_Obj_TypeCode : constant Name_Id := N + 088;
+ Name_Stub : constant Name_Id := N + 089;
+
+ -- Operator Symbol entries. The actual names have an upper case O at
+ -- the start in place of the Op_ prefix (e.g. the actual name that
+ -- corresponds to Name_Op_Abs is "Oabs".
+
+ First_Operator_Name : constant Name_Id := N + 090;
+ Name_Op_Abs : constant Name_Id := N + 090; -- "abs"
+ Name_Op_And : constant Name_Id := N + 091; -- "and"
+ Name_Op_Mod : constant Name_Id := N + 092; -- "mod"
+ Name_Op_Not : constant Name_Id := N + 093; -- "not"
+ Name_Op_Or : constant Name_Id := N + 094; -- "or"
+ Name_Op_Rem : constant Name_Id := N + 095; -- "rem"
+ Name_Op_Xor : constant Name_Id := N + 096; -- "xor"
+ Name_Op_Eq : constant Name_Id := N + 097; -- "="
+ Name_Op_Ne : constant Name_Id := N + 098; -- "/="
+ Name_Op_Lt : constant Name_Id := N + 099; -- "<"
+ Name_Op_Le : constant Name_Id := N + 100; -- "<="
+ Name_Op_Gt : constant Name_Id := N + 101; -- ">"
+ Name_Op_Ge : constant Name_Id := N + 102; -- ">="
+ Name_Op_Add : constant Name_Id := N + 103; -- "+"
+ Name_Op_Subtract : constant Name_Id := N + 104; -- "-"
+ Name_Op_Concat : constant Name_Id := N + 105; -- "&"
+ Name_Op_Multiply : constant Name_Id := N + 106; -- "*"
+ Name_Op_Divide : constant Name_Id := N + 107; -- "/"
+ Name_Op_Expon : constant Name_Id := N + 108; -- "**"
+ Last_Operator_Name : constant Name_Id := N + 108;
+
+ -- Names for all pragmas recognized by GNAT. The entries with the comment
+ -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95.
+ -- These pragmas are fully implemented in both Ada 83 and Ada 95 modes
+ -- in GNAT.
+
+ -- The entries marked GNAT are pragmas that are defined by GNAT
+ -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions
+ -- of these implementation dependent pragmas may be found in the
+ -- appropriate section in unit Sem_Prag in file sem-prag.adb.
+
+ -- The entries marked Ada05 are technically implementation dependent
+ -- pragmas, but they correspond to standard proposals for Ada 2005.
+
+ -- The entries marked VMS are VMS specific pragmas that are recognized
+ -- only in OpenVMS versions of GNAT. They are ignored in other versions
+ -- with an appropriate warning.
+
+ -- The entries marked AAMP are AAMP specific pragmas that are recognized
+ -- only in GNAT for the AAMP. They are ignored in other versions with
+ -- appropriate warnings.
+
+ First_Pragma_Name : constant Name_Id := N + 109;
+
+ -- Configuration pragmas are grouped at start
+
+ Name_Ada_83 : constant Name_Id := N + 109; -- GNAT
+ Name_Ada_95 : constant Name_Id := N + 110; -- GNAT
+ Name_Ada_05 : constant Name_Id := N + 111; -- GNAT
+ Name_C_Pass_By_Copy : constant Name_Id := N + 112; -- GNAT
+ Name_Compile_Time_Warning : constant Name_Id := N + 113; -- GNAT
+ Name_Component_Alignment : constant Name_Id := N + 114; -- GNAT
+ Name_Convention_Identifier : constant Name_Id := N + 115; -- GNAT
+ Name_Detect_Blocking : constant Name_Id := N + 116; -- Ada05
+ Name_Discard_Names : constant Name_Id := N + 117;
+ Name_Elaboration_Checks : constant Name_Id := N + 118; -- GNAT
+ Name_Eliminate : constant Name_Id := N + 119; -- GNAT
+ Name_Explicit_Overriding : constant Name_Id := N + 120;
+ Name_Extend_System : constant Name_Id := N + 121; -- GNAT
+ Name_Extensions_Allowed : constant Name_Id := N + 122; -- GNAT
+ Name_External_Name_Casing : constant Name_Id := N + 123; -- GNAT
+ Name_Float_Representation : constant Name_Id := N + 124; -- GNAT
+ Name_Initialize_Scalars : constant Name_Id := N + 125; -- GNAT
+ Name_Interrupt_State : constant Name_Id := N + 126; -- GNAT
+ Name_License : constant Name_Id := N + 127; -- GNAT
+ Name_Locking_Policy : constant Name_Id := N + 128;
+ Name_Long_Float : constant Name_Id := N + 129; -- VMS
+ Name_No_Run_Time : constant Name_Id := N + 130; -- GNAT
+ Name_No_Strict_Aliasing : constant Name_Id := N + 131; -- GNAT
+ Name_Normalize_Scalars : constant Name_Id := N + 132;
+ Name_Polling : constant Name_Id := N + 133; -- GNAT
+ Name_Persistent_Data : constant Name_Id := N + 134; -- GNAT
+ Name_Persistent_Object : constant Name_Id := N + 135; -- GNAT
+ Name_Profile : constant Name_Id := N + 136; -- Ada05
+ Name_Profile_Warnings : constant Name_Id := N + 137; -- GNAT
+ Name_Propagate_Exceptions : constant Name_Id := N + 138; -- GNAT
+ Name_Queuing_Policy : constant Name_Id := N + 139;
+ Name_Ravenscar : constant Name_Id := N + 140;
+ Name_Restricted_Run_Time : constant Name_Id := N + 141;
+ Name_Restrictions : constant Name_Id := N + 142;
+ Name_Restriction_Warnings : constant Name_Id := N + 143; -- GNAT
+ Name_Reviewable : constant Name_Id := N + 144;
+ Name_Source_File_Name : constant Name_Id := N + 145; -- GNAT
+ Name_Source_File_Name_Project : constant Name_Id := N + 146; -- GNAT
+ Name_Style_Checks : constant Name_Id := N + 147; -- GNAT
+ Name_Suppress : constant Name_Id := N + 148;
+ Name_Suppress_Exception_Locations : constant Name_Id := N + 149; -- GNAT
+ Name_Task_Dispatching_Policy : constant Name_Id := N + 150;
+ Name_Universal_Data : constant Name_Id := N + 151; -- AAMP
+ Name_Unsuppress : constant Name_Id := N + 152; -- GNAT
+ Name_Use_VADS_Size : constant Name_Id := N + 153; -- GNAT
+ Name_Validity_Checks : constant Name_Id := N + 154; -- GNAT
+ Name_Warnings : constant Name_Id := N + 155; -- GNAT
+ Last_Configuration_Pragma_Name : constant Name_Id := N + 155;
+
+ -- Remaining pragma names
+
+ Name_Abort_Defer : constant Name_Id := N + 156; -- GNAT
+ Name_All_Calls_Remote : constant Name_Id := N + 157;
+ Name_Annotate : constant Name_Id := N + 158; -- GNAT
+
+ -- Note: AST_Entry is not in this list because its name matches the
+ -- name of the corresponding attribute. However, it is included in the
+ -- definition of the type Attribute_Id, and the functions Get_Pragma_Id
+ -- and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
+ -- AST_Entry is a VMS specific pragma.
+
+ Name_Assert : constant Name_Id := N + 159; -- GNAT
+ Name_Asynchronous : constant Name_Id := N + 160;
+ Name_Atomic : constant Name_Id := N + 161;
+ Name_Atomic_Components : constant Name_Id := N + 162;
+ Name_Attach_Handler : constant Name_Id := N + 163;
+ Name_Comment : constant Name_Id := N + 164; -- GNAT
+ Name_Common_Object : constant Name_Id := N + 165; -- GNAT
+ Name_Complex_Representation : constant Name_Id := N + 166; -- GNAT
+ Name_Controlled : constant Name_Id := N + 167;
+ Name_Convention : constant Name_Id := N + 168;
+ Name_CPP_Class : constant Name_Id := N + 169; -- GNAT
+ Name_CPP_Constructor : constant Name_Id := N + 170; -- GNAT
+ Name_CPP_Virtual : constant Name_Id := N + 171; -- GNAT
+ Name_CPP_Vtable : constant Name_Id := N + 172; -- GNAT
+ Name_Debug : constant Name_Id := N + 173; -- GNAT
+ Name_Elaborate : constant Name_Id := N + 174; -- Ada 83
+ Name_Elaborate_All : constant Name_Id := N + 175;
+ Name_Elaborate_Body : constant Name_Id := N + 176;
+ Name_Export : constant Name_Id := N + 177;
+ Name_Export_Exception : constant Name_Id := N + 178; -- VMS
+ Name_Export_Function : constant Name_Id := N + 179; -- GNAT
+ Name_Export_Object : constant Name_Id := N + 180; -- GNAT
+ Name_Export_Procedure : constant Name_Id := N + 181; -- GNAT
+ Name_Export_Value : constant Name_Id := N + 182; -- GNAT
+ Name_Export_Valued_Procedure : constant Name_Id := N + 183; -- GNAT
+ Name_External : constant Name_Id := N + 184; -- GNAT
+ Name_Finalize_Storage_Only : constant Name_Id := N + 185; -- GNAT
+ Name_Ident : constant Name_Id := N + 186; -- VMS
+ Name_Import : constant Name_Id := N + 187;
+ Name_Import_Exception : constant Name_Id := N + 188; -- VMS
+ Name_Import_Function : constant Name_Id := N + 189; -- GNAT
+ Name_Import_Object : constant Name_Id := N + 190; -- GNAT
+ Name_Import_Procedure : constant Name_Id := N + 191; -- GNAT
+ Name_Import_Valued_Procedure : constant Name_Id := N + 192; -- GNAT
+ Name_Inline : constant Name_Id := N + 193;
+ Name_Inline_Always : constant Name_Id := N + 194; -- GNAT
+ Name_Inline_Generic : constant Name_Id := N + 195; -- GNAT
+ Name_Inspection_Point : constant Name_Id := N + 196;
+ Name_Interface_Name : constant Name_Id := N + 197; -- GNAT
+ Name_Interrupt_Handler : constant Name_Id := N + 198;
+ Name_Interrupt_Priority : constant Name_Id := N + 199;
+ Name_Java_Constructor : constant Name_Id := N + 200; -- GNAT
+ Name_Java_Interface : constant Name_Id := N + 201; -- GNAT
+ Name_Keep_Names : constant Name_Id := N + 202; -- GNAT
+ Name_Link_With : constant Name_Id := N + 203; -- GNAT
+ Name_Linker_Alias : constant Name_Id := N + 204; -- GNAT
+ Name_Linker_Options : constant Name_Id := N + 205;
+ Name_Linker_Section : constant Name_Id := N + 206; -- GNAT
+ Name_List : constant Name_Id := N + 207;
+ Name_Machine_Attribute : constant Name_Id := N + 208; -- GNAT
+ Name_Main : constant Name_Id := N + 209; -- GNAT
+ Name_Main_Storage : constant Name_Id := N + 210; -- GNAT
+ Name_Memory_Size : constant Name_Id := N + 211; -- Ada 83
+ Name_No_Return : constant Name_Id := N + 212; -- GNAT
+ Name_Obsolescent : constant Name_Id := N + 213; -- GNAT
+ Name_Optimize : constant Name_Id := N + 214;
+ Name_Optional_Overriding : constant Name_Id := N + 215;
+ Name_Pack : constant Name_Id := N + 216;
+ Name_Page : constant Name_Id := N + 217;
+ Name_Passive : constant Name_Id := N + 218; -- GNAT
+ Name_Preelaborate : constant Name_Id := N + 219;
+ Name_Priority : constant Name_Id := N + 220;
+ Name_Psect_Object : constant Name_Id := N + 221; -- VMS
+ Name_Pure : constant Name_Id := N + 222;
+ Name_Pure_Function : constant Name_Id := N + 223; -- GNAT
+ Name_Remote_Call_Interface : constant Name_Id := N + 224;
+ Name_Remote_Types : constant Name_Id := N + 225;
+ Name_Share_Generic : constant Name_Id := N + 226; -- GNAT
+ Name_Shared : constant Name_Id := N + 227; -- Ada 83
+ Name_Shared_Passive : constant Name_Id := N + 228;
+
+ -- Note: Storage_Size is not in this list because its name matches the
+ -- name of the corresponding attribute. However, it is included in the
+ -- definition of the type Attribute_Id, and the functions Get_Pragma_Id
+ -- and Check_Pragma_Id correctly recognize and process Name_Storage_Size.
+
+ -- Note: Storage_Unit is also omitted from the list because of a clash
+ -- with an attribute name, and is treated similarly.
+
+ Name_Source_Reference : constant Name_Id := N + 229; -- GNAT
+ Name_Stream_Convert : constant Name_Id := N + 230; -- GNAT
+ Name_Subtitle : constant Name_Id := N + 231; -- GNAT
+ Name_Suppress_All : constant Name_Id := N + 232; -- GNAT
+ Name_Suppress_Debug_Info : constant Name_Id := N + 233; -- GNAT
+ Name_Suppress_Initialization : constant Name_Id := N + 234; -- GNAT
+ Name_System_Name : constant Name_Id := N + 235; -- Ada 83
+ Name_Task_Info : constant Name_Id := N + 236; -- GNAT
+ Name_Task_Name : constant Name_Id := N + 237; -- GNAT
+ Name_Task_Storage : constant Name_Id := N + 238; -- VMS
+ Name_Thread_Body : constant Name_Id := N + 239; -- GNAT
+ Name_Time_Slice : constant Name_Id := N + 240; -- GNAT
+ Name_Title : constant Name_Id := N + 241; -- GNAT
+ Name_Unchecked_Union : constant Name_Id := N + 242; -- GNAT
+ Name_Unimplemented_Unit : constant Name_Id := N + 243; -- GNAT
+ Name_Unreferenced : constant Name_Id := N + 244; -- GNAT
+ Name_Unreserve_All_Interrupts : constant Name_Id := N + 245; -- GNAT
+ Name_Volatile : constant Name_Id := N + 246;
+ Name_Volatile_Components : constant Name_Id := N + 247;
+ Name_Weak_External : constant Name_Id := N + 248; -- GNAT
+ Last_Pragma_Name : constant Name_Id := N + 248;
+
+ -- Language convention names for pragma Convention/Export/Import/Interface
+ -- Note that Name_C is not included in this list, since it was already
+ -- declared earlier in the context of one-character identifier names
+ -- (where the order is critical to the fast look up process).
+
+ -- Note: there are no convention names corresponding to the conventions
+ -- Entry and Protected, this is because these conventions cannot be
+ -- specified by a pragma.
+
+ First_Convention_Name : constant Name_Id := N + 249;
+ Name_Ada : constant Name_Id := N + 249;
+ Name_Assembler : constant Name_Id := N + 250;
+ Name_COBOL : constant Name_Id := N + 251;
+ Name_CPP : constant Name_Id := N + 252;
+ Name_Fortran : constant Name_Id := N + 253;
+ Name_Intrinsic : constant Name_Id := N + 254;
+ Name_Java : constant Name_Id := N + 255;
+ Name_Stdcall : constant Name_Id := N + 256;
+ Name_Stubbed : constant Name_Id := N + 257;
+ Last_Convention_Name : constant Name_Id := N + 257;
+
+ -- The following names are preset as synonyms for Assembler
+
+ Name_Asm : constant Name_Id := N + 258;
+ Name_Assembly : constant Name_Id := N + 259;
+
+ -- The following names are preset as synonyms for C
+
+ Name_Default : constant Name_Id := N + 260;
+ -- Name_Exernal (previously defined as pragma)
+
+ -- The following names are present as synonyms for Stdcall
+
+ Name_DLL : constant Name_Id := N + 261;
+ Name_Win32 : constant Name_Id := N + 262;
+
+ -- Other special names used in processing pragmas
+
+ Name_As_Is : constant Name_Id := N + 263;
+ Name_Body_File_Name : constant Name_Id := N + 264;
+ Name_Boolean_Entry_Barriers : constant Name_Id := N + 265;
+ Name_Casing : constant Name_Id := N + 266;
+ Name_Code : constant Name_Id := N + 267;
+ Name_Component : constant Name_Id := N + 268;
+ Name_Component_Size_4 : constant Name_Id := N + 269;
+ Name_Copy : constant Name_Id := N + 270;
+ Name_D_Float : constant Name_Id := N + 271;
+ Name_Descriptor : constant Name_Id := N + 272;
+ Name_Dot_Replacement : constant Name_Id := N + 273;
+ Name_Dynamic : constant Name_Id := N + 274;
+ Name_Entity : constant Name_Id := N + 275;
+ Name_External_Name : constant Name_Id := N + 276;
+ Name_First_Optional_Parameter : constant Name_Id := N + 277;
+ Name_Form : constant Name_Id := N + 278;
+ Name_G_Float : constant Name_Id := N + 279;
+ Name_Gcc : constant Name_Id := N + 280;
+ Name_Gnat : constant Name_Id := N + 281;
+ Name_GPL : constant Name_Id := N + 282;
+ Name_IEEE_Float : constant Name_Id := N + 283;
+ Name_Internal : constant Name_Id := N + 284;
+ Name_Link_Name : constant Name_Id := N + 285;
+ Name_Lowercase : constant Name_Id := N + 286;
+ Name_Max_Entry_Queue_Depth : constant Name_Id := N + 287;
+ Name_Max_Entry_Queue_Length : constant Name_Id := N + 288;
+ Name_Max_Size : constant Name_Id := N + 289;
+ Name_Mechanism : constant Name_Id := N + 290;
+ Name_Mixedcase : constant Name_Id := N + 291;
+ Name_Modified_GPL : constant Name_Id := N + 292;
+ Name_Name : constant Name_Id := N + 293;
+ Name_NCA : constant Name_Id := N + 294;
+ Name_No : constant Name_Id := N + 295;
+ Name_No_Dependence : constant Name_Id := N + 296;
+ Name_No_Dynamic_Attachment : constant Name_Id := N + 297;
+ Name_No_Dynamic_Interrupts : constant Name_Id := N + 298;
+ Name_No_Requeue : constant Name_Id := N + 299;
+ Name_No_Requeue_Statements : constant Name_Id := N + 300;
+ Name_No_Task_Attributes : constant Name_Id := N + 301;
+ Name_No_Task_Attributes_Package : constant Name_Id := N + 302;
+ Name_On : constant Name_Id := N + 303;
+ Name_Parameter_Types : constant Name_Id := N + 304;
+ Name_Reference : constant Name_Id := N + 305;
+ Name_Restricted : constant Name_Id := N + 306;
+ Name_Result_Mechanism : constant Name_Id := N + 307;
+ Name_Result_Type : constant Name_Id := N + 308;
+ Name_Runtime : constant Name_Id := N + 309;
+ Name_SB : constant Name_Id := N + 310;
+ Name_Secondary_Stack_Size : constant Name_Id := N + 311;
+ Name_Section : constant Name_Id := N + 312;
+ Name_Semaphore : constant Name_Id := N + 313;
+ Name_Simple_Barriers : constant Name_Id := N + 314;
+ Name_Spec_File_Name : constant Name_Id := N + 315;
+ Name_Static : constant Name_Id := N + 316;
+ Name_Stack_Size : constant Name_Id := N + 317;
+ Name_Subunit_File_Name : constant Name_Id := N + 318;
+ Name_Task_Stack_Size_Default : constant Name_Id := N + 319;
+ Name_Task_Type : constant Name_Id := N + 320;
+ Name_Time_Slicing_Enabled : constant Name_Id := N + 321;
+ Name_Top_Guard : constant Name_Id := N + 322;
+ Name_UBA : constant Name_Id := N + 323;
+ Name_UBS : constant Name_Id := N + 324;
+ Name_UBSB : constant Name_Id := N + 325;
+ Name_Unit_Name : constant Name_Id := N + 326;
+ Name_Unknown : constant Name_Id := N + 327;
+ Name_Unrestricted : constant Name_Id := N + 328;
+ Name_Uppercase : constant Name_Id := N + 329;
+ Name_User : constant Name_Id := N + 330;
+ Name_VAX_Float : constant Name_Id := N + 331;
+ Name_VMS : constant Name_Id := N + 332;
+ Name_Working_Storage : constant Name_Id := N + 333;
+
+ -- 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
+ -- attributes are implemented in both Ada 83 and Ada 95 modes in GNAT.
+
+ -- The entries marked GNAT are attributes that are defined by GNAT
+ -- and implemented in both Ada 83 and Ada 95 modes. Full descriptions
+ -- of these implementation dependent attributes may be found in the
+ -- appropriate section in package Sem_Attr in file sem-attr.ads.
+
+ -- 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 + 334;
+ Name_Abort_Signal : constant Name_Id := N + 334; -- GNAT
+ Name_Access : constant Name_Id := N + 335;
+ Name_Address : constant Name_Id := N + 336;
+ Name_Address_Size : constant Name_Id := N + 337; -- GNAT
+ Name_Aft : constant Name_Id := N + 338;
+ Name_Alignment : constant Name_Id := N + 339;
+ Name_Asm_Input : constant Name_Id := N + 340; -- GNAT
+ Name_Asm_Output : constant Name_Id := N + 341; -- GNAT
+ Name_AST_Entry : constant Name_Id := N + 342; -- VMS
+ Name_Bit : constant Name_Id := N + 343; -- GNAT
+ Name_Bit_Order : constant Name_Id := N + 344;
+ Name_Bit_Position : constant Name_Id := N + 345; -- GNAT
+ Name_Body_Version : constant Name_Id := N + 346;
+ Name_Callable : constant Name_Id := N + 347;
+ Name_Caller : constant Name_Id := N + 348;
+ Name_Code_Address : constant Name_Id := N + 349; -- GNAT
+ Name_Component_Size : constant Name_Id := N + 350;
+ Name_Compose : constant Name_Id := N + 351;
+ Name_Constrained : constant Name_Id := N + 352;
+ Name_Count : constant Name_Id := N + 353;
+ Name_Default_Bit_Order : constant Name_Id := N + 354; -- GNAT
+ Name_Definite : constant Name_Id := N + 355;
+ Name_Delta : constant Name_Id := N + 356;
+ Name_Denorm : constant Name_Id := N + 357;
+ Name_Digits : constant Name_Id := N + 358;
+ Name_Elaborated : constant Name_Id := N + 359; -- GNAT
+ Name_Emax : constant Name_Id := N + 360; -- Ada 83
+ Name_Enum_Rep : constant Name_Id := N + 361; -- GNAT
+ Name_Epsilon : constant Name_Id := N + 362; -- Ada 83
+ Name_Exponent : constant Name_Id := N + 363;
+ Name_External_Tag : constant Name_Id := N + 364;
+ Name_First : constant Name_Id := N + 365;
+ Name_First_Bit : constant Name_Id := N + 366;
+ Name_Fixed_Value : constant Name_Id := N + 367; -- GNAT
+ Name_Fore : constant Name_Id := N + 368;
+ Name_Has_Access_Values : constant Name_Id := N + 369; -- GNAT
+ Name_Has_Discriminants : constant Name_Id := N + 370; -- GNAT
+ Name_Identity : constant Name_Id := N + 371;
+ Name_Img : constant Name_Id := N + 372; -- GNAT
+ Name_Integer_Value : constant Name_Id := N + 373; -- GNAT
+ Name_Large : constant Name_Id := N + 374; -- Ada 83
+ Name_Last : constant Name_Id := N + 375;
+ Name_Last_Bit : constant Name_Id := N + 376;
+ Name_Leading_Part : constant Name_Id := N + 377;
+ Name_Length : constant Name_Id := N + 378;
+ Name_Machine_Emax : constant Name_Id := N + 379;
+ Name_Machine_Emin : constant Name_Id := N + 380;
+ Name_Machine_Mantissa : constant Name_Id := N + 381;
+ Name_Machine_Overflows : constant Name_Id := N + 382;
+ Name_Machine_Radix : constant Name_Id := N + 383;
+ Name_Machine_Rounds : constant Name_Id := N + 384;
+ Name_Machine_Size : constant Name_Id := N + 385; -- GNAT
+ Name_Mantissa : constant Name_Id := N + 386; -- Ada 83
+ Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 387;
+ Name_Maximum_Alignment : constant Name_Id := N + 388; -- GNAT
+ Name_Mechanism_Code : constant Name_Id := N + 389; -- GNAT
+ Name_Mod : constant Name_Id := N + 390;
+ Name_Model_Emin : constant Name_Id := N + 391;
+ Name_Model_Epsilon : constant Name_Id := N + 392;
+ Name_Model_Mantissa : constant Name_Id := N + 393;
+ Name_Model_Small : constant Name_Id := N + 394;
+ Name_Modulus : constant Name_Id := N + 395;
+ Name_Null_Parameter : constant Name_Id := N + 396; -- GNAT
+ Name_Object_Size : constant Name_Id := N + 397; -- GNAT
+ Name_Partition_ID : constant Name_Id := N + 398;
+ Name_Passed_By_Reference : constant Name_Id := N + 399; -- GNAT
+ Name_Pool_Address : constant Name_Id := N + 400;
+ Name_Pos : constant Name_Id := N + 401;
+ Name_Position : constant Name_Id := N + 402;
+ Name_Range : constant Name_Id := N + 403;
+ Name_Range_Length : constant Name_Id := N + 404; -- GNAT
+ Name_Round : constant Name_Id := N + 405;
+ Name_Safe_Emax : constant Name_Id := N + 406; -- Ada 83
+ Name_Safe_First : constant Name_Id := N + 407;
+ Name_Safe_Large : constant Name_Id := N + 408; -- Ada 83
+ Name_Safe_Last : constant Name_Id := N + 409;
+ Name_Safe_Small : constant Name_Id := N + 410; -- Ada 83
+ Name_Scale : constant Name_Id := N + 411;
+ Name_Scaling : constant Name_Id := N + 412;
+ Name_Signed_Zeros : constant Name_Id := N + 413;
+ Name_Size : constant Name_Id := N + 414;
+ Name_Small : constant Name_Id := N + 415;
+ Name_Storage_Size : constant Name_Id := N + 416;
+ Name_Storage_Unit : constant Name_Id := N + 417; -- GNAT
+ Name_Stream_Size : constant Name_Id := N + 418; -- Ada 05
+ Name_Tag : constant Name_Id := N + 419;
+ Name_Target_Name : constant Name_Id := N + 420; -- GNAT
+ Name_Terminated : constant Name_Id := N + 421;
+ Name_To_Address : constant Name_Id := N + 422; -- GNAT
+ Name_Type_Class : constant Name_Id := N + 423; -- GNAT
+ Name_UET_Address : constant Name_Id := N + 424; -- GNAT
+ Name_Unbiased_Rounding : constant Name_Id := N + 425;
+ Name_Unchecked_Access : constant Name_Id := N + 426;
+ Name_Unconstrained_Array : constant Name_Id := N + 427;
+ Name_Universal_Literal_String : constant Name_Id := N + 428; -- GNAT
+ Name_Unrestricted_Access : constant Name_Id := N + 429; -- GNAT
+ Name_VADS_Size : constant Name_Id := N + 430; -- GNAT
+ Name_Val : constant Name_Id := N + 431;
+ Name_Valid : constant Name_Id := N + 432;
+ Name_Value_Size : constant Name_Id := N + 433; -- GNAT
+ Name_Version : constant Name_Id := N + 434;
+ Name_Wchar_T_Size : constant Name_Id := N + 435; -- GNAT
+ Name_Wide_Wide_Width : constant Name_Id := N + 436; -- Ada 05
+ Name_Wide_Width : constant Name_Id := N + 437;
+ Name_Width : constant Name_Id := N + 438;
+ Name_Word_Size : constant Name_Id := N + 439; -- GNAT
+
+ -- Attributes that designate attributes returning renamable functions,
+ -- i.e. functions that return other than a universal value and that
+ -- have non-universal arguments.
+
+ First_Renamable_Function_Attribute : constant Name_Id := N + 440;
+ Name_Adjacent : constant Name_Id := N + 440;
+ Name_Ceiling : constant Name_Id := N + 441;
+ Name_Copy_Sign : constant Name_Id := N + 442;
+ Name_Floor : constant Name_Id := N + 443;
+ Name_Fraction : constant Name_Id := N + 444;
+ Name_Image : constant Name_Id := N + 445;
+ Name_Input : constant Name_Id := N + 446;
+ Name_Machine : constant Name_Id := N + 447;
+ Name_Max : constant Name_Id := N + 448;
+ Name_Min : constant Name_Id := N + 449;
+ Name_Model : constant Name_Id := N + 450;
+ Name_Pred : constant Name_Id := N + 451;
+ Name_Remainder : constant Name_Id := N + 452;
+ Name_Rounding : constant Name_Id := N + 453;
+ Name_Succ : constant Name_Id := N + 454;
+ Name_Truncation : constant Name_Id := N + 455;
+ Name_Value : constant Name_Id := N + 456;
+ Name_Wide_Image : constant Name_Id := N + 457;
+ Name_Wide_Wide_Image : constant Name_Id := N + 458;
+ Name_Wide_Value : constant Name_Id := N + 459;
+ Name_Wide_Wide_Value : constant Name_Id := N + 460;
+ Last_Renamable_Function_Attribute : constant Name_Id := N + 460;
+
+ -- Attributes that designate procedures
+
+ First_Procedure_Attribute : constant Name_Id := N + 461;
+ Name_Output : constant Name_Id := N + 461;
+ Name_Read : constant Name_Id := N + 462;
+ Name_Write : constant Name_Id := N + 463;
+ Last_Procedure_Attribute : constant Name_Id := N + 463;
+
+ -- Remaining attributes are ones that return entities
+
+ First_Entity_Attribute_Name : constant Name_Id := N + 464;
+ Name_Elab_Body : constant Name_Id := N + 464; -- GNAT
+ Name_Elab_Spec : constant Name_Id := N + 465; -- GNAT
+ Name_Storage_Pool : constant Name_Id := N + 466;
+
+ -- These attributes are the ones that return types
+
+ First_Type_Attribute_Name : constant Name_Id := N + 467;
+ Name_Base : constant Name_Id := N + 467;
+ Name_Class : constant Name_Id := N + 468;
+ Last_Type_Attribute_Name : constant Name_Id := N + 468;
+ Last_Entity_Attribute_Name : constant Name_Id := N + 468;
+ Last_Attribute_Name : constant Name_Id := N + 468;
+
+ -- Names of recognized locking policy identifiers
+
+ -- Note: policies are identified by the first character of the
+ -- 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 + 469;
+ Name_Ceiling_Locking : constant Name_Id := N + 469;
+ Name_Inheritance_Locking : constant Name_Id := N + 470;
+ Last_Locking_Policy_Name : constant Name_Id := N + 470;
+
+ -- Names of recognized queuing policy identifiers.
+
+ -- Note: policies are identified by the first character of the
+ -- 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 + 471;
+ Name_FIFO_Queuing : constant Name_Id := N + 471;
+ Name_Priority_Queuing : constant Name_Id := N + 472;
+ Last_Queuing_Policy_Name : constant Name_Id := N + 472;
+
+ -- Names of recognized task dispatching policy identifiers
+
+ -- Note: policies are identified by the first character of the
+ -- 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 + 473;
+ Name_FIFO_Within_Priorities : constant Name_Id := N + 473;
+ Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 473;
+
+ -- Names of recognized checks for pragma Suppress
+
+ First_Check_Name : constant Name_Id := N + 474;
+ Name_Access_Check : constant Name_Id := N + 474;
+ Name_Accessibility_Check : constant Name_Id := N + 475;
+ Name_Discriminant_Check : constant Name_Id := N + 476;
+ Name_Division_Check : constant Name_Id := N + 477;
+ Name_Elaboration_Check : constant Name_Id := N + 478;
+ Name_Index_Check : constant Name_Id := N + 479;
+ Name_Length_Check : constant Name_Id := N + 480;
+ Name_Overflow_Check : constant Name_Id := N + 481;
+ Name_Range_Check : constant Name_Id := N + 482;
+ Name_Storage_Check : constant Name_Id := N + 483;
+ Name_Tag_Check : constant Name_Id := N + 484;
+ Name_All_Checks : constant Name_Id := N + 485;
+ Last_Check_Name : constant Name_Id := N + 485;
+
+ -- Names corresponding to reserved keywords, excluding those already
+ -- declared in the attribute list (Access, Delta, Digits, Mod, Range).
+
+ Name_Abort : constant Name_Id := N + 486;
+ Name_Abs : constant Name_Id := N + 487;
+ Name_Accept : constant Name_Id := N + 488;
+ Name_And : constant Name_Id := N + 489;
+ Name_All : constant Name_Id := N + 490;
+ Name_Array : constant Name_Id := N + 491;
+ Name_At : constant Name_Id := N + 492;
+ Name_Begin : constant Name_Id := N + 493;
+ Name_Body : constant Name_Id := N + 494;
+ Name_Case : constant Name_Id := N + 495;
+ Name_Constant : constant Name_Id := N + 496;
+ Name_Declare : constant Name_Id := N + 497;
+ Name_Delay : constant Name_Id := N + 498;
+ Name_Do : constant Name_Id := N + 499;
+ Name_Else : constant Name_Id := N + 500;
+ Name_Elsif : constant Name_Id := N + 501;
+ Name_End : constant Name_Id := N + 502;
+ Name_Entry : constant Name_Id := N + 503;
+ Name_Exception : constant Name_Id := N + 504;
+ Name_Exit : constant Name_Id := N + 505;
+ Name_For : constant Name_Id := N + 506;
+ Name_Function : constant Name_Id := N + 507;
+ Name_Generic : constant Name_Id := N + 508;
+ Name_Goto : constant Name_Id := N + 509;
+ Name_If : constant Name_Id := N + 510;
+ Name_In : constant Name_Id := N + 511;
+ Name_Is : constant Name_Id := N + 512;
+ Name_Limited : constant Name_Id := N + 513;
+ Name_Loop : constant Name_Id := N + 514;
+ Name_New : constant Name_Id := N + 515;
+ Name_Not : constant Name_Id := N + 516;
+ Name_Null : constant Name_Id := N + 517;
+ Name_Of : constant Name_Id := N + 518;
+ Name_Or : constant Name_Id := N + 519;
+ Name_Others : constant Name_Id := N + 520;
+ Name_Out : constant Name_Id := N + 521;
+ Name_Package : constant Name_Id := N + 522;
+ Name_Pragma : constant Name_Id := N + 523;
+ Name_Private : constant Name_Id := N + 524;
+ Name_Procedure : constant Name_Id := N + 525;
+ Name_Raise : constant Name_Id := N + 526;
+ Name_Record : constant Name_Id := N + 527;
+ Name_Rem : constant Name_Id := N + 528;
+ Name_Renames : constant Name_Id := N + 529;
+ Name_Return : constant Name_Id := N + 530;
+ Name_Reverse : constant Name_Id := N + 531;
+ Name_Select : constant Name_Id := N + 532;
+ Name_Separate : constant Name_Id := N + 533;
+ Name_Subtype : constant Name_Id := N + 534;
+ Name_Task : constant Name_Id := N + 535;
+ Name_Terminate : constant Name_Id := N + 536;
+ Name_Then : constant Name_Id := N + 537;
+ Name_Type : constant Name_Id := N + 538;
+ Name_Use : constant Name_Id := N + 539;
+ Name_When : constant Name_Id := N + 540;
+ Name_While : constant Name_Id := N + 541;
+ Name_With : constant Name_Id := N + 542;
+ Name_Xor : constant Name_Id := N + 543;
+
+ -- 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 + 544;
+ Name_Divide : constant Name_Id := N + 544;
+ Name_Enclosing_Entity : constant Name_Id := N + 545;
+ Name_Exception_Information : constant Name_Id := N + 546;
+ Name_Exception_Message : constant Name_Id := N + 547;
+ Name_Exception_Name : constant Name_Id := N + 548;
+ Name_File : constant Name_Id := N + 549;
+ Name_Import_Address : constant Name_Id := N + 550;
+ Name_Import_Largest_Value : constant Name_Id := N + 551;
+ Name_Import_Value : constant Name_Id := N + 552;
+ Name_Is_Negative : constant Name_Id := N + 553;
+ Name_Line : constant Name_Id := N + 554;
+ Name_Rotate_Left : constant Name_Id := N + 555;
+ Name_Rotate_Right : constant Name_Id := N + 556;
+ Name_Shift_Left : constant Name_Id := N + 557;
+ Name_Shift_Right : constant Name_Id := N + 558;
+ Name_Shift_Right_Arithmetic : constant Name_Id := N + 559;
+ Name_Source_Location : constant Name_Id := N + 560;
+ Name_Unchecked_Conversion : constant Name_Id := N + 561;
+ Name_Unchecked_Deallocation : constant Name_Id := N + 562;
+ Name_To_Pointer : constant Name_Id := N + 563;
+ Last_Intrinsic_Name : constant Name_Id := N + 563;
+
+ -- Reserved words used only in Ada 95
+
+ First_95_Reserved_Word : constant Name_Id := N + 564;
+ Name_Abstract : constant Name_Id := N + 564;
+ Name_Aliased : constant Name_Id := N + 565;
+ Name_Protected : constant Name_Id := N + 566;
+ Name_Until : constant Name_Id := N + 567;
+ Name_Requeue : constant Name_Id := N + 568;
+ Name_Tagged : constant Name_Id := N + 569;
+ Last_95_Reserved_Word : constant Name_Id := N + 569;
+
+ 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 + 570;
+
+ -- Additional reserved words and identifiers used in GNAT Project Files
+ -- Note that Name_External is already previously declared
+
+ Name_Ada_Roots : constant Name_Id := N + 571;
+ Name_Binder : constant Name_Id := N + 572;
+ Name_Binder_Driver : constant Name_Id := N + 573;
+ Name_Body_Suffix : constant Name_Id := N + 574;
+ Name_Builder : constant Name_Id := N + 575;
+ Name_Compiler : constant Name_Id := N + 576;
+ Name_Compiler_Driver : constant Name_Id := N + 577;
+ Name_Compiler_Kind : constant Name_Id := N + 578;
+ Name_Compute_Dependency : constant Name_Id := N + 579;
+ Name_Cross_Reference : constant Name_Id := N + 580;
+ Name_Default_Linker : constant Name_Id := N + 581;
+ Name_Default_Switches : constant Name_Id := N + 582;
+ Name_Dependency_Option : constant Name_Id := N + 583;
+ Name_Exec_Dir : constant Name_Id := N + 584;
+ Name_Executable : constant Name_Id := N + 585;
+ Name_Executable_Suffix : constant Name_Id := N + 586;
+ Name_Extends : constant Name_Id := N + 587;
+ Name_Externally_Built : constant Name_Id := N + 588;
+ Name_Finder : constant Name_Id := N + 589;
+ Name_Global_Configuration_Pragmas : constant Name_Id := N + 590;
+ Name_Gnatls : constant Name_Id := N + 591;
+ Name_Gnatstub : constant Name_Id := N + 592;
+ Name_Implementation : constant Name_Id := N + 593;
+ Name_Implementation_Exceptions : constant Name_Id := N + 594;
+ Name_Implementation_Suffix : constant Name_Id := N + 595;
+ Name_Include_Option : constant Name_Id := N + 596;
+ Name_Language_Processing : constant Name_Id := N + 597;
+ Name_Languages : constant Name_Id := N + 598;
+ Name_Library_Dir : constant Name_Id := N + 599;
+ Name_Library_Auto_Init : constant Name_Id := N + 600;
+ Name_Library_GCC : constant Name_Id := N + 601;
+ Name_Library_Interface : constant Name_Id := N + 602;
+ Name_Library_Kind : constant Name_Id := N + 603;
+ Name_Library_Name : constant Name_Id := N + 604;
+ Name_Library_Options : constant Name_Id := N + 605;
+ Name_Library_Reference_Symbol_File : constant Name_Id := N + 606;
+ Name_Library_Src_Dir : constant Name_Id := N + 607;
+ Name_Library_Symbol_File : constant Name_Id := N + 608;
+ Name_Library_Symbol_Policy : constant Name_Id := N + 609;
+ Name_Library_Version : constant Name_Id := N + 610;
+ Name_Linker : constant Name_Id := N + 611;
+ Name_Local_Configuration_Pragmas : constant Name_Id := N + 612;
+ Name_Locally_Removed_Files : constant Name_Id := N + 613;
+ Name_Metrics : constant Name_Id := N + 614;
+ Name_Naming : constant Name_Id := N + 615;
+ Name_Object_Dir : constant Name_Id := N + 616;
+ Name_Pretty_Printer : constant Name_Id := N + 617;
+ Name_Project : constant Name_Id := N + 618;
+ Name_Separate_Suffix : constant Name_Id := N + 619;
+ Name_Source_Dirs : constant Name_Id := N + 620;
+ Name_Source_Files : constant Name_Id := N + 621;
+ Name_Source_List_File : constant Name_Id := N + 622;
+ Name_Spec : constant Name_Id := N + 623;
+ Name_Spec_Suffix : constant Name_Id := N + 624;
+ Name_Specification : constant Name_Id := N + 625;
+ Name_Specification_Exceptions : constant Name_Id := N + 626;
+ Name_Specification_Suffix : constant Name_Id := N + 627;
+ Name_Switches : constant Name_Id := N + 628;
+
+ -- Other miscellaneous names used in front end
+
+ Name_Unaligned_Valid : constant Name_Id := N + 629;
+
+ -- ----------------------------------------------------------------
+ First_2005_Reserved_Word : constant Name_Id := N + 630;
+ Name_Interface : constant Name_Id := N + 630;
+ Name_Overriding : constant Name_Id := N + 631;
+ Name_Synchronized : constant Name_Id := N + 632;
+ Last_2005_Reserved_Word : constant Name_Id := N + 632;
+
+ subtype Ada_2005_Reserved_Words is
+ Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
+
+ -- Mark last defined name for consistency check in Snames body
+
+ Last_Predefined_Name : constant Name_Id := N + 632;
+
+ subtype Any_Operator_Name is Name_Id range
+ First_Operator_Name .. Last_Operator_Name;
+
+ ------------------------------
+ -- Attribute ID Definitions --
+ ------------------------------
+
+ type Attribute_Id is (
+ Attribute_Abort_Signal,
+ Attribute_Access,
+ Attribute_Address,
+ Attribute_Address_Size,
+ Attribute_Aft,
+ Attribute_Alignment,
+ Attribute_Asm_Input,
+ Attribute_Asm_Output,
+ Attribute_AST_Entry,
+ Attribute_Bit,
+ Attribute_Bit_Order,
+ Attribute_Bit_Position,
+ Attribute_Body_Version,
+ Attribute_Callable,
+ Attribute_Caller,
+ Attribute_Code_Address,
+ Attribute_Component_Size,
+ Attribute_Compose,
+ Attribute_Constrained,
+ Attribute_Count,
+ Attribute_Default_Bit_Order,
+ Attribute_Definite,
+ Attribute_Delta,
+ Attribute_Denorm,
+ Attribute_Digits,
+ Attribute_Elaborated,
+ Attribute_Emax,
+ Attribute_Enum_Rep,
+ Attribute_Epsilon,
+ Attribute_Exponent,
+ Attribute_External_Tag,
+ Attribute_First,
+ Attribute_First_Bit,
+ Attribute_Fixed_Value,
+ Attribute_Fore,
+ Attribute_Has_Access_Values,
+ Attribute_Has_Discriminants,
+ Attribute_Identity,
+ Attribute_Img,
+ Attribute_Integer_Value,
+ Attribute_Large,
+ Attribute_Last,
+ Attribute_Last_Bit,
+ Attribute_Leading_Part,
+ Attribute_Length,
+ Attribute_Machine_Emax,
+ Attribute_Machine_Emin,
+ Attribute_Machine_Mantissa,
+ Attribute_Machine_Overflows,
+ Attribute_Machine_Radix,
+ Attribute_Machine_Rounds,
+ Attribute_Machine_Size,
+ Attribute_Mantissa,
+ Attribute_Max_Size_In_Storage_Elements,
+ Attribute_Maximum_Alignment,
+ Attribute_Mechanism_Code,
+ Attribute_Mod,
+ Attribute_Model_Emin,
+ Attribute_Model_Epsilon,
+ Attribute_Model_Mantissa,
+ Attribute_Model_Small,
+ Attribute_Modulus,
+ Attribute_Null_Parameter,
+ Attribute_Object_Size,
+ Attribute_Partition_ID,
+ Attribute_Passed_By_Reference,
+ Attribute_Pool_Address,
+ Attribute_Pos,
+ Attribute_Position,
+ Attribute_Range,
+ Attribute_Range_Length,
+ Attribute_Round,
+ Attribute_Safe_Emax,
+ Attribute_Safe_First,
+ Attribute_Safe_Large,
+ Attribute_Safe_Last,
+ Attribute_Safe_Small,
+ Attribute_Scale,
+ Attribute_Scaling,
+ Attribute_Signed_Zeros,
+ Attribute_Size,
+ Attribute_Small,
+ Attribute_Storage_Size,
+ Attribute_Storage_Unit,
+ Attribute_Stream_Size,
+ Attribute_Tag,
+ Attribute_Target_Name,
+ Attribute_Terminated,
+ Attribute_To_Address,
+ Attribute_Type_Class,
+ Attribute_UET_Address,
+ Attribute_Unbiased_Rounding,
+ Attribute_Unchecked_Access,
+ Attribute_Unconstrained_Array,
+ Attribute_Universal_Literal_String,
+ Attribute_Unrestricted_Access,
+ Attribute_VADS_Size,
+ Attribute_Val,
+ Attribute_Valid,
+ Attribute_Value_Size,
+ Attribute_Version,
+ Attribute_Wchar_T_Size,
+ Attribute_Wide_Wide_Width,
+ Attribute_Wide_Width,
+ Attribute_Width,
+ Attribute_Word_Size,
+
+ -- Attributes designating renamable functions
+
+ Attribute_Adjacent,
+ Attribute_Ceiling,
+ Attribute_Copy_Sign,
+ Attribute_Floor,
+ Attribute_Fraction,
+ Attribute_Image,
+ Attribute_Input,
+ Attribute_Machine,
+ Attribute_Max,
+ Attribute_Min,
+ Attribute_Model,
+ Attribute_Pred,
+ Attribute_Remainder,
+ Attribute_Rounding,
+ Attribute_Succ,
+ Attribute_Truncation,
+ Attribute_Value,
+ Attribute_Wide_Image,
+ Attribute_Wide_Wide_Image,
+ Attribute_Wide_Value,
+ Attribute_Wide_Wide_Value,
+
+ -- Attributes designating procedures
+
+ Attribute_Output,
+ Attribute_Read,
+ Attribute_Write,
+
+ -- Entity attributes (includes type attributes)
+
+ Attribute_Elab_Body,
+ Attribute_Elab_Spec,
+ Attribute_Storage_Pool,
+
+ -- Type attributes
+
+ Attribute_Base,
+ Attribute_Class);
+
+ ------------------------------------
+ -- Convention Name ID Definitions --
+ ------------------------------------
+
+ type Convention_Id is (
+
+ -- The conventions that are defined by the RM come first
+
+ Convention_Ada,
+ Convention_Intrinsic,
+ Convention_Entry,
+ Convention_Protected,
+
+ -- The remaining conventions are foreign language conventions
+
+ Convention_Assembler, -- also Asm, Assembly
+ Convention_C, -- also Default, External
+ Convention_COBOL,
+ Convention_CPP,
+ Convention_Fortran,
+ Convention_Java,
+ Convention_Stdcall, -- also DLL, Win32
+ Convention_Stubbed);
+
+ -- Note: Convention C_Pass_By_Copy is allowed only for record
+ -- types (where it is treated like C except that the appropriate
+ -- flag is set in the record type). Recognizion of this convention
+ -- is specially handled in Sem_Prag.
+
+ for Convention_Id'Size use 8;
+ -- Plenty of space for expansion
+
+ subtype Foreign_Convention is
+ Convention_Id range Convention_Assembler .. Convention_Stdcall;
+
+ -----------------------------------
+ -- Locking Policy ID Definitions --
+ -----------------------------------
+
+ type Locking_Policy_Id is (
+ Locking_Policy_Inheritance_Locking,
+ Locking_Policy_Ceiling_Locking);
+
+ ---------------------------
+ -- Pragma ID Definitions --
+ ---------------------------
+
+ type Pragma_Id is (
+
+ -- Configuration pragmas
+
+ Pragma_Ada_83,
+ Pragma_Ada_95,
+ Pragma_Ada_05,
+ Pragma_C_Pass_By_Copy,
+ Pragma_Compile_Time_Warning,
+ Pragma_Component_Alignment,
+ Pragma_Convention_Identifier,
+ Pragma_Detect_Blocking,
+ Pragma_Discard_Names,
+ Pragma_Elaboration_Checks,
+ Pragma_Eliminate,
+ Pragma_Explicit_Overriding,
+ Pragma_Extend_System,
+ Pragma_Extensions_Allowed,
+ Pragma_External_Name_Casing,
+ Pragma_Float_Representation,
+ Pragma_Initialize_Scalars,
+ Pragma_Interrupt_State,
+ Pragma_License,
+ Pragma_Locking_Policy,
+ Pragma_Long_Float,
+ Pragma_No_Run_Time,
+ Pragma_No_Strict_Aliasing,
+ Pragma_Normalize_Scalars,
+ Pragma_Polling,
+ Pragma_Persistent_Data,
+ Pragma_Persistent_Object,
+ Pragma_Profile,
+ Pragma_Profile_Warnings,
+ Pragma_Propagate_Exceptions,
+ Pragma_Queuing_Policy,
+ Pragma_Ravenscar,
+ Pragma_Restricted_Run_Time,
+ Pragma_Restrictions,
+ Pragma_Restriction_Warnings,
+ Pragma_Reviewable,
+ Pragma_Source_File_Name,
+ Pragma_Source_File_Name_Project,
+ Pragma_Style_Checks,
+ Pragma_Suppress,
+ Pragma_Suppress_Exception_Locations,
+ Pragma_Task_Dispatching_Policy,
+ Pragma_Universal_Data,
+ Pragma_Unsuppress,
+ Pragma_Use_VADS_Size,
+ Pragma_Validity_Checks,
+ Pragma_Warnings,
+
+ -- Remaining (non-configuration) pragmas
+
+ Pragma_Abort_Defer,
+ Pragma_All_Calls_Remote,
+ Pragma_Annotate,
+ Pragma_Assert,
+ Pragma_Asynchronous,
+ Pragma_Atomic,
+ Pragma_Atomic_Components,
+ Pragma_Attach_Handler,
+ Pragma_Comment,
+ Pragma_Common_Object,
+ Pragma_Complex_Representation,
+ Pragma_Controlled,
+ Pragma_Convention,
+ Pragma_CPP_Class,
+ Pragma_CPP_Constructor,
+ Pragma_CPP_Virtual,
+ Pragma_CPP_Vtable,
+ Pragma_Debug,
+ Pragma_Elaborate,
+ Pragma_Elaborate_All,
+ Pragma_Elaborate_Body,
+ Pragma_Export,
+ Pragma_Export_Exception,
+ Pragma_Export_Function,
+ Pragma_Export_Object,
+ Pragma_Export_Procedure,
+ Pragma_Export_Value,
+ Pragma_Export_Valued_Procedure,
+ Pragma_External,
+ Pragma_Finalize_Storage_Only,
+ Pragma_Ident,
+ Pragma_Import,
+ Pragma_Import_Exception,
+ Pragma_Import_Function,
+ Pragma_Import_Object,
+ Pragma_Import_Procedure,
+ Pragma_Import_Valued_Procedure,
+ Pragma_Inline,
+ Pragma_Inline_Always,
+ Pragma_Inline_Generic,
+ Pragma_Inspection_Point,
+ Pragma_Interface_Name,
+ Pragma_Interrupt_Handler,
+ Pragma_Interrupt_Priority,
+ Pragma_Java_Constructor,
+ Pragma_Java_Interface,
+ Pragma_Keep_Names,
+ Pragma_Link_With,
+ Pragma_Linker_Alias,
+ Pragma_Linker_Options,
+ Pragma_Linker_Section,
+ Pragma_List,
+ Pragma_Machine_Attribute,
+ Pragma_Main,
+ Pragma_Main_Storage,
+ Pragma_Memory_Size,
+ Pragma_No_Return,
+ Pragma_Obsolescent,
+ Pragma_Optimize,
+ Pragma_Optional_Overriding,
+ Pragma_Pack,
+ Pragma_Page,
+ Pragma_Passive,
+ Pragma_Preelaborate,
+ Pragma_Priority,
+ Pragma_Psect_Object,
+ Pragma_Pure,
+ Pragma_Pure_Function,
+ Pragma_Remote_Call_Interface,
+ Pragma_Remote_Types,
+ Pragma_Share_Generic,
+ Pragma_Shared,
+ Pragma_Shared_Passive,
+ Pragma_Source_Reference,
+ Pragma_Stream_Convert,
+ Pragma_Subtitle,
+ Pragma_Suppress_All,
+ Pragma_Suppress_Debug_Info,
+ Pragma_Suppress_Initialization,
+ Pragma_System_Name,
+ Pragma_Task_Info,
+ Pragma_Task_Name,
+ Pragma_Task_Storage,
+ Pragma_Thread_Body,
+ Pragma_Time_Slice,
+ Pragma_Title,
+ Pragma_Unchecked_Union,
+ Pragma_Unimplemented_Unit,
+ Pragma_Unreferenced,
+ Pragma_Unreserve_All_Interrupts,
+ Pragma_Volatile,
+ Pragma_Volatile_Components,
+ Pragma_Weak_External,
+
+ -- The following pragmas are on their own, out of order, because of
+ -- the special processing required to deal with the fact that their
+ -- names match existing attribute names.
+
+ Pragma_AST_Entry,
+ Pragma_Interface,
+ Pragma_Storage_Size,
+ Pragma_Storage_Unit,
+
+ -- The value to represent an unknown or unrecognized pragma
+
+ Unknown_Pragma);
+
+ -----------------------------------
+ -- Queuing Policy ID definitions --
+ -----------------------------------
+
+ type Queuing_Policy_Id is (
+ Queuing_Policy_FIFO_Queuing,
+ Queuing_Policy_Priority_Queuing);
+
+ --------------------------------------------
+ -- Task Dispatching Policy ID definitions --
+ --------------------------------------------
+
+ type Task_Dispatching_Policy_Id is (
+ Task_Dispatching_FIFO_Within_Priorities);
+ -- Id values used to identify task dispatching policies
+
+ -----------------
+ -- Subprograms --
+ -----------------
+
+ procedure Initialize;
+ -- Called to initialize the preset names in the names table.
+
+ function Is_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute
+
+ function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized entity attribute,
+ -- i.e. an attribute reference that returns an entity.
+
+ function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute that
+ -- designates a procedure (and can therefore appear as a statement).
+
+ function Is_Function_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized attribute
+ -- that designates a renameable function, and can therefore appear in
+ -- a renaming statement. Note that not all attributes designating
+ -- functions are renamable, in particular, thos returning a universal
+ -- value cannot be renamed.
+
+ function Is_Type_Attribute_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized type attribute,
+ -- i.e. an attribute reference that returns a type
+
+ function Is_Check_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized suppress check
+ -- as required by pragma Suppress.
+
+ function Is_Convention_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of one of the recognized
+ -- language conventions, as required by pragma Convention, Import,
+ -- Export, Interface. Returns True if so. Also returns True for a
+ -- name that has been specified by a Convention_Identifier pragma.
+ -- If neither case holds, returns False.
+
+ function Is_Locking_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized locking policy
+
+ function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of an operator symbol
+
+ function Is_Pragma_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized pragma. Note
+ -- that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized
+ -- as pragmas by this function even though their names are separate from
+ -- the other pragma names.
+
+ function Is_Queuing_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized queuing policy
+
+ function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized task
+ -- dispatching policy.
+
+ function Get_Attribute_Id (N : Name_Id) return Attribute_Id;
+ -- Returns Id of attribute corresponding to given name. It is an error to
+ -- call this function with a name that is not the name of a attribute.
+
+ function Get_Convention_Id (N : Name_Id) return Convention_Id;
+ -- Returns Id of language convention corresponding to given name. It is an
+ -- to call this function with a name that is not the name of a convention,
+ -- or one previously given in a call to Record_Convention_Identifier.
+
+ function Get_Check_Id (N : Name_Id) return Check_Id;
+ -- Returns Id of suppress check corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id;
+ -- Returns Id of locking policy corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Pragma_Id (N : Name_Id) return Pragma_Id;
+ -- Returns Id of pragma corresponding to given name. Returns Unknown_Pragma
+ -- if N is not a name of a known (Ada defined or GNAT-specific) pragma.
+ -- Note that the function also works correctly for names of pragmas that
+ -- are not in the main list of pragma Names (AST_Entry, Storage_Size, and
+ -- Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size).
+
+ function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;
+ -- Returns Id of queuing policy corresponding to given name. It is an error
+ -- to call this function with a name that is not the name of a check.
+
+ function Get_Task_Dispatching_Policy_Id
+ (N : Name_Id)
+ return Task_Dispatching_Policy_Id;
+ -- Returns Id of task dispatching policy corresponding to given name.
+ -- It is an error to call this function with a name that is not the
+ -- name of a check.
+
+ procedure Record_Convention_Identifier
+ (Id : Name_Id;
+ Convention : Convention_Id);
+ -- A call to this procedure, resulting from an occurrence of a pragma
+ -- Convention_Identifier, records that from now on an occurrence of
+ -- Id will be recognized as a name for the specified convention.
+
+private
+ pragma Inline (Is_Attribute_Name);
+ pragma Inline (Is_Entity_Attribute_Name);
+ pragma Inline (Is_Type_Attribute_Name);
+ pragma Inline (Is_Check_Name);
+ pragma Inline (Is_Locking_Policy_Name);
+ pragma Inline (Is_Operator_Symbol_Name);
+ pragma Inline (Is_Queuing_Policy_Name);
+ pragma Inline (Is_Pragma_Name);
+ pragma Inline (Is_Task_Dispatching_Policy_Name);
+
+end Snames;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
function Make_DT_Component
(Loc : Source_Ptr;
Typ : Entity_Id;
- I : Positive) return Node_Id;
- -- Gives a reference to the Ith component of the Dispatch Table of
+ N : Positive) return Node_Id;
+ -- Gives a reference to the Nth component of the Dispatch Table of
-- a given Tagged Type.
--
- -- I = 1 --> Inheritance_Depth
- -- I = 2 --> Tags (array of ancestors)
- -- I = 3, 4 --> predefined primitive
+ -- N = 1 --> Inheritance_Depth
+ -- N = 2 --> Tags (array of ancestors)
+ -- N = 3, 4 --> predefined primitive
-- function _Size (X : Typ) return Long_Long_Integer;
-- function _Equality (X : Typ; Y : Typ'Class) return Boolean;
- -- I >= 5 --> User-Defined Primitive Operations
+ -- N >= 5 --> User-Defined Primitive Operations
function Make_DT_Access
(Loc : Source_Ptr; Rec : Node_Id; Typ : Entity_Id) return Node_Id;
|| (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== ARRAY_TYPE))
&& (0 == (best_type
- == find_common_type (right_type,
- TREE_TYPE (TREE_OPERAND
- (right_operand, 0))))
+ = find_common_type (right_type,
+ TREE_TYPE (TREE_OPERAND
+ (right_operand, 0))))
|| right_type != best_type))
{
right_operand = TREE_OPERAND (right_operand, 0);
OSDN Git Service
