[multiple changes]
2004-05-27 Vincent Celier <celier@gnat.com> * vms_data.ads: Add new GNAT PRETTY qualifiers /NO_BACKUP and COMMENTS_LAYOUT=UNTOUCHED * symbols-vms.adb, symbols-vms-alpha.adb: Renamed symbols-vms.adb to symbols-vms-alpha.adb 2004-05-27 Thomas Quinot <quinot@act-europe.fr> * sem.ads: Clarify documentation on checks suppression. * einfo.ads (Is_Known_Non_Null): Minor comment typo fix and rephrasing. 2004-05-27 Ed Schonberg <schonberg@gnat.com> * sem_util.adb (Is_Descendent_Of): Examine properly all ancestors in the case of multiple derivations. (Is_Object_Reference): For a selected component, verify that the prefix is itself an object and not a value. * sem_ch12.adb (Same_Instantiated_Constant): New name for Same_Instantiated_Entity. (Same_Instantiated_Variable): Subsidiary to Check_Formal_Package_Instance, to recognize actuals for in-out generic formals that are obtained from a previous formal package. (Instantiate_Subprogram_Body): Emit proper error when generating code and the proper body of a stub is missing. * sem_ch4.adb (Remove_Address_Interpretations): If the operation still has a universal interpretation, do the disambiguation here. * exp_ch4.adb (Expand_N_Type_Conversion, Expand_N_Unchecked_Type_Conversion): Special handling when target type is Address, to avoid typing anomalies when Address is a visible integer type. * exp_ch6.adb (Expand_N_Subprogram_Body): Use Is_Descendent_Of_Address to determine whether a subprogram should not be marked Pure, even when declared in a pure package. 2004-05-27 Jose Ruiz <ruiz@act-europe.fr> * gnat_ugn.texi: Replace pragma Ravenscar by pragma Profile. * gnat_rm.texi: Replace Max_Entry_Queue_Depth by Max_Entry_Queue_Length Document No_Dynamic_Attachment, that supersedes No_Dynamic_Interrupts. Update the documentation about the Ravenscar profile, following the definition found in AI-249. * sem_prag.adb: Use FIFO_Within_Priorities and Ceiling_Locking when setting the Profile (Ravenscar). This must be done in addition to setting the required restrictions. * rtsfind.ads: Add the set of operations defined in package Ada.Interrupts. * exp_ch6.adb: Check whether we are violating the No_Dynamic_Attachment restriction. 2004-05-27 Eric Botcazou <ebotcazou@act-europe.fr> lang-specs.h: Always require -c or -S and always redirect to /dev/null if -gnatc or -gnats is passed. 2004-05-27 Hristian Kirtchev <kirtchev@gnat.com> * sem_prag.adb (Sig_Flags): A Pragma_Unchecked_Union does not count as a significant reference. Warnings are now properly emitted when a discriminated type is not referenced. * lib-xref.adb (Generate_Reference): A deferred constant completion, record representation clause or record type discriminant does not produce a reference to its corresponding entity. Warnings are now properly emitted when deferred constants and record types are not referenced. 2004-05-27 Geert Bosch <bosch@gnat.com> * Makefile.in: Use long version of libm routines on ia64 gnu/linux. Fixes ACATS Annex G tests. 2004-05-27 Robert Dewar <dewar@gnat.com> * rtsfind.adb (RTU_Loaded): Temporary kludge to get past bug of not handling WITH 2004-05-27 Arnaud Charlet <charlet@act-europe.fr> * s-interr.adb (Server_Task): Take into account case of early return from sigwait under e.g. linux. 2004-05-27 Sergey Rybin <rybin@act-europe.fr> * gnat_ugn.texi: Add description for the new gnatpp options: -rnb - replace the original source without creating its backup copy -c0 - do not format comments From-SVN: r82324
This commit is contained in:
parent
062583ea1c
commit
8a36a0ccd8
@ -1,3 +1,101 @@
|
||||
2004-05-27 Vincent Celier <celier@gnat.com>
|
||||
|
||||
* vms_data.ads: Add new GNAT PRETTY qualifiers /NO_BACKUP and
|
||||
COMMENTS_LAYOUT=UNTOUCHED
|
||||
|
||||
* symbols-vms.adb, symbols-vms-alpha.adb: Renamed symbols-vms.adb to
|
||||
symbols-vms-alpha.adb
|
||||
|
||||
2004-05-27 Thomas Quinot <quinot@act-europe.fr>
|
||||
|
||||
* sem.ads: Clarify documentation on checks suppression.
|
||||
|
||||
* einfo.ads (Is_Known_Non_Null): Minor comment typo fix and rephrasing.
|
||||
|
||||
2004-05-27 Ed Schonberg <schonberg@gnat.com>
|
||||
|
||||
* sem_util.adb (Is_Descendent_Of): Examine properly all ancestors in
|
||||
the case of multiple derivations.
|
||||
(Is_Object_Reference): For a selected component, verify that the prefix
|
||||
is itself an object and not a value.
|
||||
|
||||
* sem_ch12.adb (Same_Instantiated_Constant): New name for
|
||||
Same_Instantiated_Entity.
|
||||
(Same_Instantiated_Variable): Subsidiary to
|
||||
Check_Formal_Package_Instance, to recognize actuals for in-out generic
|
||||
formals that are obtained from a previous formal package.
|
||||
(Instantiate_Subprogram_Body): Emit proper error when
|
||||
generating code and the proper body of a stub is missing.
|
||||
|
||||
* sem_ch4.adb (Remove_Address_Interpretations): If the operation still
|
||||
has a universal interpretation, do the disambiguation here.
|
||||
|
||||
* exp_ch4.adb (Expand_N_Type_Conversion,
|
||||
Expand_N_Unchecked_Type_Conversion): Special handling when target type
|
||||
is Address, to avoid typing anomalies when Address is a visible integer
|
||||
type.
|
||||
|
||||
* exp_ch6.adb (Expand_N_Subprogram_Body): Use Is_Descendent_Of_Address
|
||||
to determine whether a subprogram should not be marked Pure, even when
|
||||
declared in a pure package.
|
||||
|
||||
2004-05-27 Jose Ruiz <ruiz@act-europe.fr>
|
||||
|
||||
* gnat_ugn.texi: Replace pragma Ravenscar by pragma Profile.
|
||||
|
||||
* gnat_rm.texi: Replace Max_Entry_Queue_Depth by Max_Entry_Queue_Length
|
||||
Document No_Dynamic_Attachment, that supersedes No_Dynamic_Interrupts.
|
||||
Update the documentation about the Ravenscar profile, following the
|
||||
definition found in AI-249.
|
||||
|
||||
* sem_prag.adb: Use FIFO_Within_Priorities and Ceiling_Locking when
|
||||
setting the Profile (Ravenscar). This must be done in addition to
|
||||
setting the required restrictions.
|
||||
|
||||
* rtsfind.ads: Add the set of operations defined in package
|
||||
Ada.Interrupts.
|
||||
|
||||
* exp_ch6.adb: Check whether we are violating the No_Dynamic_Attachment
|
||||
restriction.
|
||||
|
||||
2004-05-27 Eric Botcazou <ebotcazou@act-europe.fr>
|
||||
|
||||
lang-specs.h: Always require -c or -S and always redirect to /dev/null
|
||||
if -gnatc or -gnats is passed.
|
||||
|
||||
2004-05-27 Hristian Kirtchev <kirtchev@gnat.com>
|
||||
|
||||
* sem_prag.adb (Sig_Flags): A Pragma_Unchecked_Union does not count as
|
||||
a significant reference. Warnings are now properly emitted when a
|
||||
discriminated type is not referenced.
|
||||
|
||||
* lib-xref.adb (Generate_Reference): A deferred constant completion,
|
||||
record representation clause or record type discriminant does not
|
||||
produce a reference to its corresponding entity. Warnings are now
|
||||
properly emitted when deferred constants and record types are not
|
||||
referenced.
|
||||
|
||||
2004-05-27 Geert Bosch <bosch@gnat.com>
|
||||
|
||||
* Makefile.in: Use long version of libm routines on ia64 gnu/linux.
|
||||
Fixes ACATS Annex G tests.
|
||||
|
||||
2004-05-27 Robert Dewar <dewar@gnat.com>
|
||||
|
||||
* rtsfind.adb (RTU_Loaded): Temporary kludge to get past bug of not
|
||||
handling WITH
|
||||
|
||||
2004-05-27 Arnaud Charlet <charlet@act-europe.fr>
|
||||
|
||||
* s-interr.adb (Server_Task): Take into account case of early return
|
||||
from sigwait under e.g. linux.
|
||||
|
||||
2004-05-27 Sergey Rybin <rybin@act-europe.fr>
|
||||
|
||||
* gnat_ugn.texi: Add description for the new gnatpp options:
|
||||
-rnb - replace the original source without creating its backup copy
|
||||
-c0 - do not format comments
|
||||
|
||||
2004-05-24 Geert Bosch <bosch@gnat.com>
|
||||
|
||||
* a-numaux-x86.adb (Reduce): Reimplement using an approximation of Pi
|
||||
|
@ -1260,6 +1260,7 @@ endif
|
||||
ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
|
||||
LIBGNAT_TARGET_PAIRS = \
|
||||
a-intnam.ads<a-intnam-linux.ads \
|
||||
a-numaux.ads<a-numaux-libc-x86.ads \
|
||||
s-inmaop.adb<s-inmaop-posix.adb \
|
||||
s-intman.adb<s-intman-posix.adb \
|
||||
s-osinte.ads<s-osinte-linux.ads \
|
||||
|
@ -1970,12 +1970,12 @@ package Einfo is
|
||||
-- Present in all entities. Relevant (and can be set True) only for
|
||||
-- objects of an access type. It is set if the object is currently
|
||||
-- known to have a non-null value (meaning that no access checks
|
||||
-- are needed). The indication can for example3 come from assignment
|
||||
-- are needed). The indication can for example come from assignment
|
||||
-- of an access parameter or an allocator.
|
||||
--
|
||||
-- Note: this flag is set according to the sequential flow of the
|
||||
-- program, watching the current value of the variable. However,
|
||||
-- this processing can cases of changing the value of an aliased
|
||||
-- this processing can miss cases of changing the value of an aliased
|
||||
-- or constant object, so even if this flag is set, it should not
|
||||
-- be believed if the variable is aliased or volatile. It would
|
||||
-- be a little neater to avoid the flag being set in the first
|
||||
|
@ -6221,10 +6221,17 @@ package body Exp_Ch4 is
|
||||
|
||||
-- Reset overflow flag, since the range check will include
|
||||
-- dealing with possible overflow, and generate the check
|
||||
-- If Address is either source or target type, suppress
|
||||
-- range check to avoid typing anomalies when it is a visible
|
||||
-- integer type.
|
||||
|
||||
Set_Do_Overflow_Check (N, False);
|
||||
Generate_Range_Check
|
||||
(Expr, Target_Type, CE_Range_Check_Failed);
|
||||
if not Is_Descendent_Of_Address (Etype (Expr))
|
||||
and then not Is_Descendent_Of_Address (Target_Type)
|
||||
then
|
||||
Generate_Range_Check
|
||||
(Expr, Target_Type, CE_Range_Check_Failed);
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
@ -6288,7 +6295,17 @@ package body Exp_Ch4 is
|
||||
Val <= Expr_Value (Type_High_Bound (Target_Type))
|
||||
then
|
||||
Rewrite (N, Make_Integer_Literal (Sloc (N), Val));
|
||||
Analyze_And_Resolve (N, Target_Type);
|
||||
|
||||
-- If Address is the target type, just set the type
|
||||
-- to avoid a spurious type error on the literal when
|
||||
-- Address is a visible integer type.
|
||||
|
||||
if Is_Descendent_Of_Address (Target_Type) then
|
||||
Set_Etype (N, Target_Type);
|
||||
else
|
||||
Analyze_And_Resolve (N, Target_Type);
|
||||
end if;
|
||||
|
||||
return;
|
||||
end if;
|
||||
end;
|
||||
|
@ -1833,10 +1833,27 @@ package body Exp_Ch6 is
|
||||
Subp := Parent_Subp;
|
||||
end if;
|
||||
|
||||
-- Check for violation of No_Abort_Statements
|
||||
|
||||
if Is_RTE (Subp, RE_Abort_Task) then
|
||||
Check_Restriction (No_Abort_Statements, N);
|
||||
|
||||
-- Check for violation of No_Dynamic_Attachment
|
||||
|
||||
elsif RTU_Loaded (Ada_Interrupts)
|
||||
and then (Is_RTE (Subp, RE_Is_Reserved) or else
|
||||
Is_RTE (Subp, RE_Is_Attached) or else
|
||||
Is_RTE (Subp, RE_Current_Handler) or else
|
||||
Is_RTE (Subp, RE_Attach_Handler) or else
|
||||
Is_RTE (Subp, RE_Exchange_Handler) or else
|
||||
Is_RTE (Subp, RE_Detach_Handler) or else
|
||||
Is_RTE (Subp, RE_Reference))
|
||||
then
|
||||
Check_Restriction (No_Dynamic_Attachment, N);
|
||||
end if;
|
||||
|
||||
-- Deal with case where call is an explicit dereference
|
||||
|
||||
if Nkind (Name (N)) = N_Explicit_Dereference then
|
||||
|
||||
-- Handle case of access to protected subprogram type
|
||||
@ -3189,7 +3206,7 @@ package body Exp_Ch6 is
|
||||
|
||||
begin
|
||||
while Present (F) loop
|
||||
if Is_RTE (Root_Type (Etype (F)), RE_Address) then
|
||||
if Is_Descendent_Of_Address (Etype (F)) then
|
||||
Set_Is_Pure (Spec_Id, False);
|
||||
|
||||
if Spec_Id /= Body_Id then
|
||||
|
@ -151,10 +151,10 @@ Implementation Defined Pragmas
|
||||
* Pragma Obsolescent::
|
||||
* Pragma Passive::
|
||||
* Pragma Polling::
|
||||
* Pragma Profile (Ravenscar)::
|
||||
* Pragma Propagate_Exceptions::
|
||||
* Pragma Psect_Object::
|
||||
* Pragma Pure_Function::
|
||||
* Pragma Ravenscar::
|
||||
* Pragma Restricted_Run_Time::
|
||||
* Pragma Restriction_Warnings::
|
||||
* Pragma Source_File_Name::
|
||||
@ -641,10 +641,10 @@ consideration, the use of these pragmas should be minimized.
|
||||
* Pragma Obsolescent::
|
||||
* Pragma Passive::
|
||||
* Pragma Polling::
|
||||
* Pragma Profile (Ravenscar)::
|
||||
* Pragma Propagate_Exceptions::
|
||||
* Pragma Psect_Object::
|
||||
* Pragma Pure_Function::
|
||||
* Pragma Ravenscar::
|
||||
* Pragma Restricted_Run_Time::
|
||||
* Pragma Restriction_Warnings::
|
||||
* Pragma Source_File_Name::
|
||||
@ -2804,6 +2804,147 @@ to test for an abort condition.
|
||||
Note that polling can also be enabled by use of the @code{-gnatP} switch. See
|
||||
the @cite{GNAT User's Guide} for details.
|
||||
|
||||
@node Pragma Profile (Ravenscar)
|
||||
@unnumberedsec Pragma Profile (Ravenscar)
|
||||
@findex Ravenscar
|
||||
@noindent
|
||||
Syntax:
|
||||
|
||||
@smallexample @c ada
|
||||
pragma Profile (Ravenscar);
|
||||
@end smallexample
|
||||
|
||||
@noindent
|
||||
A configuration pragma that establishes the following set of configuration
|
||||
pragmas:
|
||||
|
||||
@table @code
|
||||
@item Task_Dispatching_Policy (FIFO_Within_Priorities)
|
||||
[RM D.2.2] Tasks are dispatched following a preemptive
|
||||
priority-ordered scheduling policy.
|
||||
|
||||
@item Locking_Policy (Ceiling_Locking)
|
||||
[RM D.3] While tasks and interrupts execute a protected action, they inherit
|
||||
the ceiling priority of the corresponding protected object.
|
||||
@c
|
||||
@c @item Detect_Blocking
|
||||
@c This pragma forces the detection of potentially blocking operations within a
|
||||
@c protected operation, and to raise Program_Error if that happens.
|
||||
@end table
|
||||
@noindent
|
||||
|
||||
plus the following set of restrictions:
|
||||
|
||||
@table @code
|
||||
@item Max_Entry_Queue_Length = 1
|
||||
Defines the maximum number of calls that are queued on a (protected) entry.
|
||||
Note that this restrictions is checked at run time. Violation of this
|
||||
restriction results in the raising of Program_Error exception at the point of
|
||||
the call. For the Profile (Ravenscar) the value of Max_Entry_Queue_Length is
|
||||
always 1 and hence no task can be queued on a protected entry.
|
||||
|
||||
@item Max_Protected_Entries = 1
|
||||
[RM D.7] Specifies the maximum number of entries per protected type. The
|
||||
bounds of every entry family of a protected unit shall be static, or shall be
|
||||
defined by a discriminant of a subtype whose corresponding bound is static.
|
||||
For the Profile (Ravenscar) the value of Max_Protected_Entries is always 1.
|
||||
|
||||
@item Max_Task_Entries = 0
|
||||
[RM D.7] Specifies the maximum number of entries
|
||||
per task. The bounds of every entry family
|
||||
of a task unit shall be static, or shall be
|
||||
defined by a discriminant of a subtype whose
|
||||
corresponding bound is static. A value of zero
|
||||
indicates that no rendezvous are possible. For
|
||||
the Profile (Ravenscar), the value of Max_Task_Entries is always
|
||||
0 (zero).
|
||||
|
||||
@item No_Abort_Statements
|
||||
[RM D.7] There are no abort_statements, and there are
|
||||
no calls to Task_Identification.Abort_Task.
|
||||
|
||||
@item No_Asynchronous_Control
|
||||
[RM D.7] There are no semantic dependences on the package
|
||||
Asynchronous_Task_Control.
|
||||
|
||||
@item No_Calendar
|
||||
There are no semantic dependencies on the package Ada.Calendar.
|
||||
|
||||
@item No_Dynamic_Attachment
|
||||
There is no call to any of the operations defined in package Ada.Interrupts
|
||||
(Is_Reserved, Is_Attached, Current_Handler, Attach_Handler, Exchange_Handler,
|
||||
Detach_Handler, and Reference).
|
||||
|
||||
@item No_Dynamic_Priorities
|
||||
[RM D.7] There are no semantic dependencies on the package Dynamic_Priorities.
|
||||
|
||||
@item No_Implicit_Heap_Allocations
|
||||
[RM D.7] No constructs are allowed to cause implicit heap allocation.
|
||||
|
||||
@item No_Local_Protected_Objects
|
||||
Protected objects and access types that designate
|
||||
such objects shall be declared only at library level.
|
||||
|
||||
@item No_Protected_Type_Allocators
|
||||
There are no allocators for protected types or
|
||||
types containing protected subcomponents.
|
||||
|
||||
@item No_Relative_Delay
|
||||
There are no delay_relative statements.
|
||||
|
||||
@item No_Requeue_Statements
|
||||
Requeue statements are not allowed.
|
||||
|
||||
@item No_Select_Statements
|
||||
There are no select_statements.
|
||||
|
||||
@item No_Task_Allocators
|
||||
[RM D.7] There are no allocators for task types
|
||||
or types containing task subcomponents.
|
||||
|
||||
@item No_Task_Attributes_Package
|
||||
There are no semantic dependencies on the Ada.Task_Attributes package.
|
||||
|
||||
@item No_Task_Hierarchy
|
||||
[RM D.7] All (non-environment) tasks depend
|
||||
directly on the environment task of the partition.
|
||||
|
||||
@item No_Task_Termination
|
||||
Tasks which terminate are erroneous.
|
||||
|
||||
@item Simple_Barriers
|
||||
Entry barrier condition expressions shall be either static
|
||||
boolean expressions or boolean objects which are declared in
|
||||
the protected type which contains the entry.
|
||||
@end table
|
||||
|
||||
@noindent
|
||||
This set of configuration pragmas and restrictions correspond to the
|
||||
definition of the ``Ravenscar Profile'' for limited tasking, devised and
|
||||
published by the @cite{International Real-Time Ada Workshop}, 1997,
|
||||
and whose most recent description is available at
|
||||
@url{ftp://ftp.openravenscar.org/openravenscar/ravenscar00.pdf}.
|
||||
|
||||
The original definition of the profile was revised at subsequent IRTAW
|
||||
meetings. It has been included in the ISO
|
||||
@cite{Guide for the Use of the Ada Programming Language in High
|
||||
Integrity Systems}, and has been approved by ISO/IEC/SC22/WG9 for inclusion in
|
||||
the next revision of the standard. The formal definition given by
|
||||
the Ada Rapporteur Group (ARG) can be found in two Ada Issues (AI-249 and
|
||||
AI-305) available at
|
||||
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00249.TXT} and
|
||||
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00305.TXT}
|
||||
respectively.
|
||||
|
||||
The above set is a superset of the restrictions provided by pragma
|
||||
@code{Restricted_Run_Time}, it includes six additional restrictions
|
||||
(@code{Simple_Barriers}, @code{No_Select_Statements},
|
||||
@code{No_Calendar}, @code{No_Implicit_Heap_Allocations},
|
||||
@code{No_Relative_Delay} and @code{No_Task_Termination}). This means
|
||||
that pragma @code{Profile (Ravenscar)}, like the pragma
|
||||
@code{Restricted_Run_Time}, automatically causes the use of a simplified,
|
||||
more efficient version of the tasking run-time system.
|
||||
|
||||
@node Pragma Propagate_Exceptions
|
||||
@unnumberedsec Pragma Propagate_Exceptions
|
||||
@findex Propagate_Exceptions
|
||||
@ -2914,123 +3055,6 @@ applies to the underlying renamed function. This can be used to
|
||||
disambiguate cases of overloading where some but not all functions
|
||||
in a set of overloaded functions are to be designated as pure.
|
||||
|
||||
@node Pragma Ravenscar
|
||||
@unnumberedsec Pragma Ravenscar
|
||||
@findex Ravenscar
|
||||
@noindent
|
||||
Syntax:
|
||||
|
||||
@smallexample @c ada
|
||||
pragma Ravenscar;
|
||||
@end smallexample
|
||||
|
||||
@noindent
|
||||
A configuration pragma that establishes the following set of restrictions:
|
||||
|
||||
@table @code
|
||||
@item No_Abort_Statements
|
||||
[RM D.7] There are no abort_statements, and there are
|
||||
no calls to Task_Identification.Abort_Task.
|
||||
|
||||
@item No_Select_Statements
|
||||
There are no select_statements.
|
||||
|
||||
@item No_Task_Hierarchy
|
||||
[RM D.7] All (non-environment) tasks depend
|
||||
directly on the environment task of the partition.
|
||||
|
||||
@item No_Task_Allocators
|
||||
[RM D.7] There are no allocators for task types
|
||||
or types containing task subcomponents.
|
||||
|
||||
@item No_Dynamic_Priorities
|
||||
[RM D.7] There are no semantic dependencies on the package Dynamic_Priorities.
|
||||
|
||||
@item No_Terminate_Alternatives
|
||||
[RM D.7] There are no selective_accepts with terminate_alternatives
|
||||
|
||||
@item No_Dynamic_Interrupts
|
||||
There are no semantic dependencies on Ada.Interrupts.
|
||||
|
||||
@item No_Implicit_Heap_Allocations
|
||||
[RM D.7] No constructs are allowed to cause implicit heap allocation
|
||||
|
||||
@item No_Protected_Type_Allocators
|
||||
There are no allocators for protected types or
|
||||
types containing protected subcomponents.
|
||||
|
||||
@item No_Local_Protected_Objects
|
||||
Protected objects and access types that designate
|
||||
such objects shall be declared only at library level.
|
||||
|
||||
@item No_Requeue_Statements
|
||||
Requeue statements are not allowed.
|
||||
|
||||
@item No_Calendar
|
||||
There are no semantic dependencies on the package Ada.Calendar.
|
||||
|
||||
@item No_Relative_Delay
|
||||
There are no delay_relative_statements.
|
||||
|
||||
@item No_Task_Attributes_Package
|
||||
There are no semantic dependencies on the Ada.Task_Attributes package.
|
||||
|
||||
@item Simple_Barriers
|
||||
Entry barrier condition expressions shall be either static
|
||||
boolean expressions or boolean objects which are declared in
|
||||
the protected type which contains the entry.
|
||||
|
||||
@item Max_Asynchronous_Select_Nesting = 0
|
||||
[RM D.7] Specifies the maximum dynamic nesting level of asynchronous_selects.
|
||||
A value of zero prevents the use of any asynchronous_select.
|
||||
|
||||
@item Max_Task_Entries = 0
|
||||
[RM D.7] Specifies the maximum number of entries
|
||||
per task. The bounds of every entry family
|
||||
of a task unit shall be static, or shall be
|
||||
defined by a discriminant of a subtype whose
|
||||
corresponding bound is static. A value of zero
|
||||
indicates that no rendezvous are possible. For
|
||||
the Ravenscar pragma, the value of Max_Task_Entries is always
|
||||
0 (zero).
|
||||
|
||||
@item Max_Protected_Entries = 1
|
||||
[RM D.7] Specifies the maximum number of entries per
|
||||
protected type. The bounds of every entry family of
|
||||
a protected unit shall be static, or shall be defined
|
||||
by a discriminant of a subtype whose corresponding
|
||||
bound is static. For the Ravenscar pragma the value of
|
||||
Max_Protected_Entries is always 1.
|
||||
|
||||
@item Max_Select_Alternatives = 0
|
||||
[RM D.7] Specifies the maximum number of alternatives in a selective_accept.
|
||||
For the Ravenscar pragma the value is always 0.
|
||||
|
||||
@item No_Task_Termination
|
||||
Tasks which terminate are erroneous.
|
||||
|
||||
@item No_Entry_Queue
|
||||
No task can be queued on a protected entry. Note that this restrictions is
|
||||
checked at run time. The violation of this restriction generates a
|
||||
Program_Error exception.
|
||||
@end table
|
||||
|
||||
@noindent
|
||||
This set of restrictions corresponds to the definition of the ``Ravenscar
|
||||
Profile'' for limited tasking, devised and published by the
|
||||
@cite{International Real-Time Ada Workshop}, 1997,
|
||||
and whose most recent description is available at
|
||||
@url{ftp://ftp.openravenscar.org/openravenscar/ravenscar00.pdf}.
|
||||
|
||||
The above set is a superset of the restrictions provided by pragma
|
||||
@code{Restricted_Run_Time}, it includes five additional restrictions
|
||||
(@code{Simple_Barriers}, @code{No_Select_Statements},
|
||||
@code{No_Calendar},
|
||||
@code{No_Relative_Delay} and @code{No_Task_Termination}). This means
|
||||
that pragma @code{Ravenscar}, like the pragma @code{Restricted_Run_Time},
|
||||
automatically causes the use of a simplified, more efficient version
|
||||
of the tasking run-time system.
|
||||
|
||||
@node Pragma Restricted_Run_Time
|
||||
@unnumberedsec Pragma Restricted_Run_Time
|
||||
@findex Restricted_Run_Time
|
||||
@ -3051,7 +3075,7 @@ A configuration pragma that establishes the following set of restrictions:
|
||||
@item No_Task_Allocators
|
||||
@item No_Dynamic_Priorities
|
||||
@item No_Terminate_Alternatives
|
||||
@item No_Dynamic_Interrupts
|
||||
@item No_Dynamic_Attachment
|
||||
@item No_Protected_Type_Allocators
|
||||
@item No_Local_Protected_Objects
|
||||
@item No_Requeue_Statements
|
||||
@ -5984,8 +6008,8 @@ restrictions to produce a more efficient implementation.
|
||||
@end cartouche
|
||||
GNAT currently takes advantage of these restrictions by providing an optimized
|
||||
run time when the Ravenscar profile and the GNAT restricted run time set
|
||||
of restrictions are specified. See pragma @code{Ravenscar} and pragma
|
||||
@code{Restricted_Run_Time} for more details.
|
||||
of restrictions are specified. See pragma @code{Profile (Ravenscar)} and
|
||||
pragma @code{Restricted_Run_Time} for more details.
|
||||
|
||||
@cindex Time, monotonic
|
||||
@unnumberedsec D.8(47-49): Monotonic Time
|
||||
@ -6855,10 +6879,10 @@ for protected types are restricted to either static boolean expressions or
|
||||
references to simple boolean variables defined in the private part of the
|
||||
protected type. No other form of entry barriers is permitted. This is one
|
||||
of the restrictions of the Ravenscar profile for limited tasking (see also
|
||||
pragma @code{Ravenscar}).
|
||||
pragma @code{Profile (Ravenscar)}).
|
||||
|
||||
@item Max_Entry_Queue_Depth => Expr
|
||||
@findex Max_Entry_Queue_Depth
|
||||
@item Max_Entry_Queue_Length => Expr
|
||||
@findex Max_Entry_Queue_Length
|
||||
This restriction is a declaration that any protected entry compiled in
|
||||
the scope of the restriction has at most the specified number of
|
||||
tasks waiting on the entry
|
||||
@ -6879,10 +6903,10 @@ from Boolean). This is intended for use in safety critical programs
|
||||
where the certification protocol requires the use of short-circuit
|
||||
(and then, or else) forms for all composite boolean operations.
|
||||
|
||||
@item No_Dynamic_Interrupts
|
||||
@findex No_Dynamic_Interrupts
|
||||
This restriction ensures at compile time that there is no attempt to
|
||||
dynamically associate interrupts. Only static association is allowed.
|
||||
@item No_Dynamic_Attachment
|
||||
@findex No_Dynamic_Attachment
|
||||
This restriction ensures that there is no call to any of the operations
|
||||
defined in package Ada.Interrupts.
|
||||
|
||||
@item No_Enumeration_Maps
|
||||
@findex No_Enumeration_Maps
|
||||
@ -6978,7 +7002,7 @@ on some targets.
|
||||
This restriction ensures at compile time no select statements of any kind
|
||||
are permitted, that is the keyword @code{select} may not appear.
|
||||
This is one of the restrictions of the Ravenscar
|
||||
profile for limited tasking (see also pragma @code{Ravenscar}).
|
||||
profile for limited tasking (see also pragma @code{Profile (Ravenscar)}).
|
||||
|
||||
@item No_Standard_Storage_Pools
|
||||
@findex No_Standard_Storage_Pools
|
||||
|
@ -9995,9 +9995,9 @@ recognized by @code{GNAT}:
|
||||
Long_Float
|
||||
Normalize_Scalars
|
||||
Polling
|
||||
Profile
|
||||
Propagate_Exceptions
|
||||
Queuing_Policy
|
||||
Ravenscar
|
||||
Restricted_Run_Time
|
||||
Restrictions
|
||||
Reviewable
|
||||
@ -14647,6 +14647,9 @@ on their effect.
|
||||
|
||||
@table @option
|
||||
@cindex @option{^-c@var{n}^/COMMENTS_LAYOUT^} (@command{gnatpp})
|
||||
@item ^-c0^/COMMENTS_LAYOUT=UNTOUCHED^
|
||||
All the comments remain unchanged
|
||||
|
||||
@item ^-c1^/COMMENTS_LAYOUT=DEFAULT^
|
||||
GNAT-style comment line indentation (this is the default).
|
||||
|
||||
@ -14680,7 +14683,8 @@ stops.
|
||||
@noindent
|
||||
The @option{-c1} and @option{-c2} switches are incompatible.
|
||||
The @option{-c3} and @option{-c4} switches are compatible with each other and
|
||||
also with @option{-c1} and @option{-c2}.
|
||||
also with @option{-c1} and @option{-c2}. The @option{-c0} switch disables all
|
||||
the other comment formatting switches.
|
||||
|
||||
The @option{-l1}, @option{-l2}, and @option{-l3} switches are incompatible.
|
||||
@end ifclear
|
||||
@ -14827,6 +14831,11 @@ reading or processing the input file.
|
||||
@cindex @option{^-rf^/OVERRIDING_REPLACE^} (@code{gnatpp})
|
||||
Like @option{^-r^/REPLACE^} except that if the file with the specified name
|
||||
already exists, it is overwritten.
|
||||
|
||||
@item ^-rnb^/NO_BACKUP^
|
||||
@cindex @option{^-rnb^/NO_BACKUP^} (@code{gnatpp})
|
||||
Replace the input source file with the reformatted output without
|
||||
creating any backup copy of the input source.
|
||||
@end table
|
||||
|
||||
@noindent
|
||||
|
@ -32,13 +32,12 @@
|
||||
{"@ada",
|
||||
"\
|
||||
%{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
|
||||
%{!gnatc*:%{!gnats*:%{!S:%{!c:\
|
||||
%eone of -c, -S, -gnatc or -gnats is required for Ada}}}}\
|
||||
%{!S:%{!c:%e-c or -S required for Ada}}\
|
||||
gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %1 %{!Q:-quiet} %{nostdinc*}\
|
||||
%{nostdlib*}\
|
||||
-dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
|
||||
%{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\
|
||||
%{!S:%{o*:%w%*-gnatO}} \
|
||||
%i %{S:%W{o*}%{!o*:-o %b.s}} \
|
||||
%{!S:%{gnatc*|gnats*: -o %j}} \
|
||||
%{gnatc*|gnats*: -o %j} \
|
||||
%{!gnatc*:%{!gnats*:%(invoke_as)}}", 0, 0, 0},
|
||||
|
@ -269,6 +269,27 @@ package body Lib.Xref is
|
||||
then
|
||||
null;
|
||||
|
||||
-- Constant completion does not count as a reference
|
||||
|
||||
elsif Typ = 'c'
|
||||
and then Ekind (E) = E_Constant
|
||||
then
|
||||
null;
|
||||
|
||||
-- Record representation clause does not count as a reference
|
||||
|
||||
elsif Nkind (N) = N_Identifier
|
||||
and then Nkind (Parent (N)) = N_Record_Representation_Clause
|
||||
then
|
||||
null;
|
||||
|
||||
-- Discriminants do not need to produce a reference to record type
|
||||
|
||||
elsif Typ = 'd'
|
||||
and then Nkind (Parent (N)) = N_Discriminant_Specification
|
||||
then
|
||||
null;
|
||||
|
||||
-- Any other occurrence counts as referencing the entity
|
||||
|
||||
else
|
||||
|
@ -147,8 +147,8 @@ package body Rtsfind is
|
||||
Use_Setting : Boolean := False);
|
||||
-- Load the unit whose Id is given if not already loaded. The unit is
|
||||
-- loaded, analyzed, and added to the WITH list, and the entry in
|
||||
-- RT_Unit_Table is updated to reflect the load. The second parameter
|
||||
-- indicates the initial setting for the Is_Potentially_Use_Visible
|
||||
-- RT_Unit_Table is updated to reflect the load. Use_Setting is used
|
||||
-- to indicate the initial setting for the Is_Potentially_Use_Visible
|
||||
-- flag of the entity for the loaded unit (if it is indeed loaded).
|
||||
-- A value of False means nothing special need be done. A value of
|
||||
-- True indicates that this flag must be set to True. It is needed
|
||||
@ -1052,7 +1052,9 @@ package body Rtsfind is
|
||||
|
||||
function RTU_Loaded (U : RTU_Id) return Boolean is
|
||||
begin
|
||||
return Present (RT_Unit_Table (U).Entity);
|
||||
return True and Present (RT_Unit_Table (U).Entity);
|
||||
-- Temp kludge, return True, deals with bug of loading unit with
|
||||
-- WITH not being registered as a proper rtsfind load ???
|
||||
end RTU_Loaded;
|
||||
|
||||
--------------------
|
||||
|
@ -450,6 +450,13 @@ package Rtsfind is
|
||||
RE_List_Controller, -- Ada.Finalization.List_Controller
|
||||
|
||||
RE_Interrupt_ID, -- Ada.Interrupts
|
||||
RE_Is_Reserved, -- Ada.Interrupts
|
||||
RE_Is_Attached, -- Ada.Interrupts
|
||||
RE_Current_Handler, -- Ada.Interrupts
|
||||
RE_Attach_Handler, -- Ada.Interrupts
|
||||
RE_Exchange_Handler, -- Ada.Interrupts
|
||||
RE_Detach_Handler, -- Ada.Interrupts
|
||||
RE_Reference, -- Ada.Interrupts
|
||||
|
||||
RE_Names, -- Ada.Interupts.Names
|
||||
|
||||
@ -1522,6 +1529,13 @@ package Rtsfind is
|
||||
RE_List_Controller => Ada_Finalization_List_Controller,
|
||||
|
||||
RE_Interrupt_ID => Ada_Interrupts,
|
||||
RE_Is_Reserved => Ada_Interrupts,
|
||||
RE_Is_Attached => Ada_Interrupts,
|
||||
RE_Current_Handler => Ada_Interrupts,
|
||||
RE_Attach_Handler => Ada_Interrupts,
|
||||
RE_Exchange_Handler => Ada_Interrupts,
|
||||
RE_Detach_Handler => Ada_Interrupts,
|
||||
RE_Reference => Ada_Interrupts,
|
||||
|
||||
RE_Names => Ada_Interrupts_Names,
|
||||
|
||||
|
@ -305,9 +305,8 @@ package body System.Interrupts is
|
||||
-- Bind_Interrupt_To_Entry --
|
||||
-----------------------------
|
||||
|
||||
-- This procedure raises a Program_Error if it tries to
|
||||
-- bind an interrupt to which an Entry or a Procedure is
|
||||
-- already bound.
|
||||
-- This procedure raises a Program_Error if it tries to bind an
|
||||
-- interrupt to which an Entry or a Procedure is already bound.
|
||||
|
||||
procedure Bind_Interrupt_To_Entry
|
||||
(T : Task_Id;
|
||||
@ -315,7 +314,7 @@ package body System.Interrupts is
|
||||
Int_Ref : System.Address)
|
||||
is
|
||||
Interrupt : constant Interrupt_ID :=
|
||||
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
|
||||
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
|
||||
|
||||
begin
|
||||
if Is_Reserved (Interrupt) then
|
||||
@ -324,7 +323,6 @@ package body System.Interrupts is
|
||||
end if;
|
||||
|
||||
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
|
||||
|
||||
end Bind_Interrupt_To_Entry;
|
||||
|
||||
---------------------
|
||||
@ -383,7 +381,6 @@ package body System.Interrupts is
|
||||
end if;
|
||||
|
||||
Interrupt_Manager.Detach_Handler (Interrupt, Static);
|
||||
|
||||
end Detach_Handler;
|
||||
|
||||
------------------------------
|
||||
@ -404,8 +401,8 @@ package body System.Interrupts is
|
||||
-- previous handler's binding status (ie. do not care if it is a
|
||||
-- dynamic or static handler).
|
||||
|
||||
-- This option is needed so that during the finalization of a PO, we
|
||||
-- can detach handlers attached through pragma Attach_Handler.
|
||||
-- This option is needed so that during the finalization of a PO,
|
||||
-- we can detach handlers attached through pragma Attach_Handler.
|
||||
|
||||
procedure Exchange_Handler
|
||||
(Old_Handler : out Parameterless_Handler;
|
||||
@ -421,12 +418,11 @@ package body System.Interrupts is
|
||||
|
||||
Interrupt_Manager.Exchange_Handler
|
||||
(Old_Handler, New_Handler, Interrupt, Static);
|
||||
|
||||
end Exchange_Handler;
|
||||
|
||||
----------------
|
||||
-- Finalize --
|
||||
----------------
|
||||
--------------
|
||||
-- Finalize --
|
||||
--------------
|
||||
|
||||
procedure Finalize (Object : in out Static_Interrupt_Protection) is
|
||||
begin
|
||||
@ -451,7 +447,7 @@ package body System.Interrupts is
|
||||
-- Has_Interrupt_Or_Attach_Handler --
|
||||
-------------------------------------
|
||||
|
||||
-- Need comments as to why these always return True
|
||||
-- Need comments as to why these always return True ???
|
||||
|
||||
function Has_Interrupt_Or_Attach_Handler
|
||||
(Object : access Dynamic_Interrupt_Protection) return Boolean
|
||||
@ -602,7 +598,6 @@ package body System.Interrupts is
|
||||
end loop;
|
||||
|
||||
return False;
|
||||
|
||||
end Is_Registered;
|
||||
|
||||
-----------------
|
||||
@ -804,7 +799,6 @@ package body System.Interrupts is
|
||||
else
|
||||
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
||||
end if;
|
||||
|
||||
end Unbind_Handler;
|
||||
|
||||
--------------------------------
|
||||
@ -832,6 +826,7 @@ package body System.Interrupts is
|
||||
-- status of the current_Handler.
|
||||
|
||||
if not Static and then User_Handler (Interrupt).Static then
|
||||
|
||||
-- Tries to detach a static Interrupt Handler.
|
||||
-- raise a program error.
|
||||
|
||||
@ -854,7 +849,6 @@ package body System.Interrupts is
|
||||
if Old_Handler /= null then
|
||||
Unbind_Handler (Interrupt);
|
||||
end if;
|
||||
|
||||
end Unprotected_Detach_Handler;
|
||||
|
||||
----------------------------------
|
||||
@ -866,7 +860,8 @@ package body System.Interrupts is
|
||||
New_Handler : Parameterless_Handler;
|
||||
Interrupt : Interrupt_ID;
|
||||
Static : Boolean;
|
||||
Restoration : Boolean := False) is
|
||||
Restoration : Boolean := False)
|
||||
is
|
||||
begin
|
||||
if User_Entry (Interrupt).T /= Null_Task then
|
||||
|
||||
@ -951,7 +946,6 @@ package body System.Interrupts is
|
||||
if Old_Handler = null then
|
||||
Bind_Handler (Interrupt);
|
||||
end if;
|
||||
|
||||
end Unprotected_Exchange_Handler;
|
||||
|
||||
-- Start of processing for Interrupt_Manager
|
||||
@ -1081,6 +1075,7 @@ package body System.Interrupts is
|
||||
-- Place Task_Id info in Server_ID array.
|
||||
|
||||
if Server_ID (Interrupt) = Null_Task then
|
||||
|
||||
-- When a new Server_Task is created, it should have its
|
||||
-- signal mask set to the All_Tasks_Mask.
|
||||
|
||||
@ -1100,6 +1095,7 @@ package body System.Interrupts is
|
||||
for J in Interrupt_ID'Range loop
|
||||
if not Is_Reserved (J) then
|
||||
if User_Entry (J).T = T then
|
||||
|
||||
-- The interrupt should no longer be ingnored if
|
||||
-- it was ever ignored.
|
||||
|
||||
@ -1111,7 +1107,7 @@ package body System.Interrupts is
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- Indicate in ATCB that no Interrupt Entries are attached.
|
||||
-- Indicate in ATCB that no Interrupt Entries are attached
|
||||
|
||||
T.Interrupt_Entry := False;
|
||||
end Detach_Interrupt_Entries;
|
||||
@ -1133,10 +1129,10 @@ package body System.Interrupts is
|
||||
if User_Handler (Interrupt).H /= null
|
||||
or else User_Entry (Interrupt).T /= Null_Task
|
||||
then
|
||||
-- This is the case where the Server_Task is waiting on
|
||||
-- "sigwait." Wake it up by sending an
|
||||
-- Abort_Task_Interrupt so that the Server_Task waits on
|
||||
-- Cond.
|
||||
-- This is the case where the Server_Task is waiting
|
||||
-- on "sigwait." Wake it up by sending an
|
||||
-- Abort_Task_Interrupt so that the Server_Task
|
||||
-- waits on Cond.
|
||||
|
||||
POP.Abort_Task (Server_ID (Interrupt));
|
||||
|
||||
@ -1166,6 +1162,7 @@ package body System.Interrupts is
|
||||
then
|
||||
-- No handler is attached. Unmask the Interrupt so that
|
||||
-- the default action can be carried out.
|
||||
|
||||
IMOP.Thread_Unblock_Interrupt
|
||||
(IMNG.Interrupt_ID (Interrupt));
|
||||
|
||||
@ -1174,6 +1171,7 @@ package body System.Interrupts is
|
||||
-- since it was being blocked and an Interrupt Hander or
|
||||
-- an Entry was there. Wake it up and let it change
|
||||
-- it place of waiting according to its new state.
|
||||
|
||||
POP.Wakeup (Server_ID (Interrupt),
|
||||
Interrupt_Server_Blocked_Interrupt_Sleep);
|
||||
end if;
|
||||
@ -1356,69 +1354,78 @@ package body System.Interrupts is
|
||||
POP.Write_Lock (Self_ID);
|
||||
|
||||
else
|
||||
pragma Assert (Ret_Interrupt = Interrupt);
|
||||
|
||||
if Single_Lock then
|
||||
POP.Lock_RTS;
|
||||
end if;
|
||||
|
||||
POP.Write_Lock (Self_ID);
|
||||
|
||||
-- Even though we have received an Interrupt the status may
|
||||
-- have changed already before we got the Self_ID lock above.
|
||||
-- Therefore we make sure a Handler or an Entry is still
|
||||
-- there and make appropriate call.
|
||||
-- If there is no calls to make we need to regenerate the
|
||||
-- Interrupt in order not to lose it.
|
||||
if Ret_Interrupt /= Interrupt then
|
||||
|
||||
if User_Handler (Interrupt).H /= null then
|
||||
Tmp_Handler := User_Handler (Interrupt).H;
|
||||
-- On some systems (e.g. recent linux kernels), sigwait
|
||||
-- may return unexpectedly (with errno set to EINTR).
|
||||
|
||||
-- RTS calls should not be made with self being locked.
|
||||
|
||||
POP.Unlock (Self_ID);
|
||||
|
||||
if Single_Lock then
|
||||
POP.Unlock_RTS;
|
||||
end if;
|
||||
|
||||
Tmp_Handler.all;
|
||||
|
||||
if Single_Lock then
|
||||
POP.Lock_RTS;
|
||||
end if;
|
||||
|
||||
POP.Write_Lock (Self_ID);
|
||||
|
||||
elsif User_Entry (Interrupt).T /= Null_Task then
|
||||
Tmp_ID := User_Entry (Interrupt).T;
|
||||
Tmp_Entry_Index := User_Entry (Interrupt).E;
|
||||
|
||||
-- RTS calls should not be made with self being locked.
|
||||
|
||||
if Single_Lock then
|
||||
POP.Unlock_RTS;
|
||||
end if;
|
||||
|
||||
POP.Unlock (Self_ID);
|
||||
|
||||
System.Tasking.Rendezvous.Call_Simple
|
||||
(Tmp_ID, Tmp_Entry_Index, System.Null_Address);
|
||||
|
||||
POP.Write_Lock (Self_ID);
|
||||
|
||||
if Single_Lock then
|
||||
POP.Lock_RTS;
|
||||
end if;
|
||||
null;
|
||||
|
||||
else
|
||||
-- This is a situation that this task wake up
|
||||
-- receiving an Interrupt and before it get the lock
|
||||
-- the Interrupt is blocked. We do not
|
||||
-- want to lose the interrupt in this case so that
|
||||
-- regenerate the Interrupt to process level;
|
||||
-- Even though we have received an Interrupt the status may
|
||||
-- have changed already before we got the Self_ID lock above
|
||||
-- Therefore we make sure a Handler or an Entry is still
|
||||
-- there and make appropriate call.
|
||||
|
||||
IMOP.Interrupt_Self_Process (IMNG.Interrupt_ID (Interrupt));
|
||||
-- If there is no calls to make we need to regenerate the
|
||||
-- Interrupt in order not to lose it.
|
||||
|
||||
if User_Handler (Interrupt).H /= null then
|
||||
Tmp_Handler := User_Handler (Interrupt).H;
|
||||
|
||||
-- RTS calls should not be made with self being locked.
|
||||
|
||||
POP.Unlock (Self_ID);
|
||||
|
||||
if Single_Lock then
|
||||
POP.Unlock_RTS;
|
||||
end if;
|
||||
|
||||
Tmp_Handler.all;
|
||||
|
||||
if Single_Lock then
|
||||
POP.Lock_RTS;
|
||||
end if;
|
||||
|
||||
POP.Write_Lock (Self_ID);
|
||||
|
||||
elsif User_Entry (Interrupt).T /= Null_Task then
|
||||
Tmp_ID := User_Entry (Interrupt).T;
|
||||
Tmp_Entry_Index := User_Entry (Interrupt).E;
|
||||
|
||||
-- RTS calls should not be made with self being locked.
|
||||
|
||||
if Single_Lock then
|
||||
POP.Unlock_RTS;
|
||||
end if;
|
||||
|
||||
POP.Unlock (Self_ID);
|
||||
|
||||
System.Tasking.Rendezvous.Call_Simple
|
||||
(Tmp_ID, Tmp_Entry_Index, System.Null_Address);
|
||||
|
||||
POP.Write_Lock (Self_ID);
|
||||
|
||||
if Single_Lock then
|
||||
POP.Lock_RTS;
|
||||
end if;
|
||||
|
||||
else
|
||||
-- This is a situation that this task wakes up receiving
|
||||
-- an Interrupt and before it gets the lock the Interrupt
|
||||
-- is blocked. We do not want to lose the interrupt in
|
||||
-- this case so we regenerate the Interrupt to process
|
||||
-- level.
|
||||
|
||||
IMOP.Interrupt_Self_Process
|
||||
(IMNG.Interrupt_ID (Interrupt));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
@ -1433,30 +1440,30 @@ package body System.Interrupts is
|
||||
|
||||
-- Undefer abort here to allow a window for this task
|
||||
-- to be aborted at the time of system shutdown.
|
||||
|
||||
end loop;
|
||||
end Server_Task;
|
||||
|
||||
-- Elaboration code for package System.Interrupts
|
||||
|
||||
begin
|
||||
|
||||
-- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
|
||||
|
||||
Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
|
||||
|
||||
-- During the elaboration of this package body we want RTS to
|
||||
-- inherit the interrupt mask from the Environment Task.
|
||||
-- During the elaboration of this package body we want the RTS
|
||||
-- to inherit the interrupt mask from the Environment Task.
|
||||
|
||||
-- The Environment Task should have gotten its mask from
|
||||
-- The environment task should have gotten its mask from
|
||||
-- the enclosing process during the RTS start up. (See
|
||||
-- in s-inmaop.adb). Pass the Interrupt_Mask of the Environment
|
||||
-- task to the Interrupt_Manager.
|
||||
-- processing in s-inmaop.adb). Pass the Interrupt_Mask
|
||||
-- of the environment task to the Interrupt_Manager.
|
||||
|
||||
-- Note : At this point we know that all tasks (including
|
||||
-- RTS internal servers) are masked for non-reserved signals
|
||||
-- (see s-taprop.adb). Only the Interrupt_Manager will have
|
||||
-- masks set up differently inheriting the original Environment
|
||||
-- Task's mask.
|
||||
-- masks set up differently inheriting the original environment
|
||||
-- task's mask.
|
||||
|
||||
Interrupt_Manager.Initialize (IMOP.Environment_Mask);
|
||||
end System.Interrupts;
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -347,20 +347,22 @@ package Sem is
|
||||
-- Handling of Check Suppression --
|
||||
-----------------------------------
|
||||
|
||||
-- There are two kinds of suppress checks, scope based suppress checks
|
||||
-- (from initial command line arguments, or from Suppress pragmas not
|
||||
-- including an entity name). The scope based suppress checks are recorded
|
||||
-- There are two kinds of suppress checks: scope based suppress checks,
|
||||
-- and entity based suppress checks.
|
||||
|
||||
-- Scope based suppress chems (from initial command line arguments,
|
||||
-- or from Suppress pragmas not including an entity name) are recorded
|
||||
-- in the Sem.Supress variable, and all that is necessary is to save the
|
||||
-- state of this variable on scope entry, and restore it on scope exit.
|
||||
|
||||
-- The other kind of suppress check is entity based suppress checks, from
|
||||
-- Suppress pragmas giving an Entity_Id. These are handled as follows. If
|
||||
-- a suppress or unsuppress pragma is encountered for a given entity, then
|
||||
-- the flag Checks_May_Be_Suppressed is set in the entity and an entry is
|
||||
-- made in either the Local_Entity_Suppress table (case of pragma that
|
||||
-- appears in other than a package spec), or in the Global_Entity_Suppress
|
||||
-- table (case of pragma that appears in a package spec, which is by the
|
||||
-- rule of RM 11.5(7) applicable throughout the life of the entity).
|
||||
-- Entity based suppress checks, from Suppress pragmas giving an Entity_Id,
|
||||
-- are handled as follows. If a suppress or unsuppress pragma is
|
||||
-- encountered for a given entity, then the flag Checks_May_Be_Suppressed
|
||||
-- is set in the entity and an entry is made in either the
|
||||
-- Local_Entity_Suppress table (case of pragma that appears in other than
|
||||
-- a package spec), or in the Global_Entity_Suppress table (case of pragma
|
||||
-- that appears in a package spec, which is by the rule of RM 11.5(7)
|
||||
-- applicable throughout the life of the entity).
|
||||
|
||||
-- If the Checks_May_Be_Suppressed flag is set in an entity then the
|
||||
-- procedure is to search first the local and then the global suppress
|
||||
|
@ -3636,12 +3636,17 @@ package body Sem_Ch12 is
|
||||
-- Common error routine for mismatch between the parameters of
|
||||
-- the actual instance and those of the formal package.
|
||||
|
||||
function Same_Instantiated_Entity (E1, E2 : Entity_Id) return Boolean;
|
||||
function Same_Instantiated_Constant (E1, E2 : Entity_Id) return Boolean;
|
||||
-- The formal may come from a nested formal package, and the actual
|
||||
-- may have been constant-folded. To determine whether the two denote
|
||||
-- the same entity we may have to traverse several definitions to
|
||||
-- recover the ultimate entity that they refer to.
|
||||
|
||||
function Same_Instantiated_Variable (E1, E2 : Entity_Id) return Boolean;
|
||||
-- Similarly, if the formal comes from a nested formal package, the
|
||||
-- actual may designate the formal through multiple renamings, which
|
||||
-- have to be followed to determine the original variable in question.
|
||||
|
||||
--------------------
|
||||
-- Check_Mismatch --
|
||||
--------------------
|
||||
@ -3655,13 +3660,14 @@ package body Sem_Ch12 is
|
||||
end if;
|
||||
end Check_Mismatch;
|
||||
|
||||
------------------------------
|
||||
-- Same_Instantiated_Entity --
|
||||
------------------------------
|
||||
--------------------------------
|
||||
-- Same_Instantiated_Constant --
|
||||
--------------------------------
|
||||
|
||||
function Same_Instantiated_Entity (E1, E2 : Entity_Id) return Boolean is
|
||||
function Same_Instantiated_Constant
|
||||
(E1, E2 : Entity_Id) return Boolean
|
||||
is
|
||||
Ent : Entity_Id;
|
||||
|
||||
begin
|
||||
Ent := E2;
|
||||
while Present (Ent) loop
|
||||
@ -3689,7 +3695,43 @@ package body Sem_Ch12 is
|
||||
end loop;
|
||||
|
||||
return False;
|
||||
end Same_Instantiated_Entity;
|
||||
end Same_Instantiated_Constant;
|
||||
|
||||
--------------------------------
|
||||
-- Same_Instantiated_Variable --
|
||||
--------------------------------
|
||||
|
||||
function Same_Instantiated_Variable
|
||||
(E1, E2 : Entity_Id) return Boolean
|
||||
is
|
||||
function Original_Entity (E : Entity_Id) return Entity_Id;
|
||||
-- Follow chain of renamings to the ultimate ancestor.
|
||||
|
||||
---------------------
|
||||
-- Original_Entity --
|
||||
---------------------
|
||||
|
||||
function Original_Entity (E : Entity_Id) return Entity_Id is
|
||||
Orig : Entity_Id;
|
||||
|
||||
begin
|
||||
Orig := E;
|
||||
while Nkind (Parent (Orig)) = N_Object_Renaming_Declaration
|
||||
and then Present (Renamed_Object (Orig))
|
||||
and then Is_Entity_Name (Renamed_Object (Orig))
|
||||
loop
|
||||
Orig := Entity (Renamed_Object (Orig));
|
||||
end loop;
|
||||
|
||||
return Orig;
|
||||
end Original_Entity;
|
||||
|
||||
-- Start of processing for Same_Instantiated_Variable
|
||||
|
||||
begin
|
||||
return Ekind (E1) = Ekind (E2)
|
||||
and then Original_Entity (E1) = Original_Entity (E2);
|
||||
end Same_Instantiated_Variable;
|
||||
|
||||
-- Start of processing for Check_Formal_Package_Instance
|
||||
|
||||
@ -3768,13 +3810,10 @@ package body Sem_Ch12 is
|
||||
if Is_Entity_Name (Expr2) then
|
||||
if Entity (Expr1) = Entity (Expr2) then
|
||||
null;
|
||||
|
||||
elsif
|
||||
Same_Instantiated_Entity (Entity (Expr1), Entity (Expr2))
|
||||
then
|
||||
null;
|
||||
else
|
||||
Check_Mismatch (True);
|
||||
Check_Mismatch
|
||||
(not Same_Instantiated_Constant
|
||||
(Entity (Expr1), Entity (Expr2)));
|
||||
end if;
|
||||
else
|
||||
Check_Mismatch (True);
|
||||
@ -3783,7 +3822,7 @@ package body Sem_Ch12 is
|
||||
elsif Is_Entity_Name (Original_Node (Expr1))
|
||||
and then Is_Entity_Name (Expr2)
|
||||
and then
|
||||
Same_Instantiated_Entity
|
||||
Same_Instantiated_Constant
|
||||
(Entity (Original_Node (Expr1)), Entity (Expr2))
|
||||
then
|
||||
null;
|
||||
@ -3795,9 +3834,10 @@ package body Sem_Ch12 is
|
||||
Check_Mismatch (True);
|
||||
end if;
|
||||
|
||||
elsif Ekind (E1) = E_Variable
|
||||
or else Ekind (E1) = E_Package
|
||||
then
|
||||
elsif Ekind (E1) = E_Variable then
|
||||
Check_Mismatch (not Same_Instantiated_Variable (E1, E2));
|
||||
|
||||
elsif Ekind (E1) = E_Package then
|
||||
Check_Mismatch
|
||||
(Ekind (E1) /= Ekind (E2)
|
||||
or else Renamed_Object (E1) /= Renamed_Object (E2));
|
||||
@ -7350,7 +7390,15 @@ package body Sem_Ch12 is
|
||||
if Nkind (Gen_Body) = N_Subprogram_Body_Stub then
|
||||
|
||||
-- Either body is not present, or context is non-expanding, as
|
||||
-- when compiling a subunit. Mark the instance as completed.
|
||||
-- when compiling a subunit. Mark the instance as completed, and
|
||||
-- diagnose a missing body when needed.
|
||||
|
||||
if Expander_Active
|
||||
and then Operating_Mode = Generate_Code
|
||||
then
|
||||
Error_Msg_N
|
||||
("missing proper body for instantiation", Gen_Body);
|
||||
end if;
|
||||
|
||||
Set_Has_Completion (Anon_Id);
|
||||
return;
|
||||
|
@ -4361,6 +4361,7 @@ package body Sem_Ch4 is
|
||||
-- truly hidden.
|
||||
|
||||
type Operand_Position is (First_Op, Second_Op);
|
||||
Univ_Type : constant Entity_Id := Universal_Interpretation (N);
|
||||
|
||||
procedure Remove_Address_Interpretations (Op : Operand_Position);
|
||||
-- Ambiguities may arise when the operands are literal and the
|
||||
@ -4451,6 +4452,25 @@ package body Sem_Ch4 is
|
||||
Remove_Interp (I);
|
||||
end if;
|
||||
|
||||
Get_Next_Interp (I, It);
|
||||
end loop;
|
||||
|
||||
elsif Is_Overloaded (N)
|
||||
and then Present (Univ_Type)
|
||||
then
|
||||
-- If both operands have a universal interpretation,
|
||||
-- select the predefined operator and discard others.
|
||||
|
||||
Get_First_Interp (N, I, It);
|
||||
|
||||
while Present (It.Nam) loop
|
||||
if Scope (It.Nam) = Standard_Standard then
|
||||
Set_Etype (N, Univ_Type);
|
||||
Set_Entity (N, It.Nam);
|
||||
Set_Is_Overloaded (N, False);
|
||||
exit;
|
||||
end if;
|
||||
|
||||
Get_Next_Interp (I, It);
|
||||
end loop;
|
||||
end if;
|
||||
|
@ -561,6 +561,12 @@ package body Sem_Prag is
|
||||
-- argument has the right form then the Mechanism field of Ent is
|
||||
-- set appropriately.
|
||||
|
||||
procedure Set_Ravenscar_Profile (N : Node_Id);
|
||||
-- Activate the set of configuration pragmas and restrictions that
|
||||
-- make up the Ravenscar Profile. N is the corresponding pragma
|
||||
-- node, which is used for error messages on any constructs
|
||||
-- that violate the profile.
|
||||
|
||||
--------------------------
|
||||
-- Check_Ada_83_Warning --
|
||||
--------------------------
|
||||
@ -3257,8 +3263,7 @@ package body Sem_Prag is
|
||||
Val : Uint;
|
||||
|
||||
procedure Set_Warning (R : All_Restrictions);
|
||||
-- If this is a Restriction_Warnings pragma, set warning flag,
|
||||
-- otherwise flag gets cleared.
|
||||
-- If this is a Restriction_Warnings pragma, set warning flag
|
||||
|
||||
-----------------
|
||||
-- Set_Warning --
|
||||
@ -3266,8 +3271,9 @@ package body Sem_Prag is
|
||||
|
||||
procedure Set_Warning (R : All_Restrictions) is
|
||||
begin
|
||||
Restriction_Warnings (R) :=
|
||||
Prag_Id = Pragma_Restriction_Warnings;
|
||||
if Prag_Id = Pragma_Restriction_Warnings then
|
||||
Restriction_Warnings (R) := True;
|
||||
end if;
|
||||
end Set_Warning;
|
||||
|
||||
-- Start of processing for Process_Restrictions_Or_Restriction_Warnings
|
||||
@ -3821,6 +3827,70 @@ package body Sem_Prag is
|
||||
|
||||
end Set_Mechanism_Value;
|
||||
|
||||
---------------------------
|
||||
-- Set_Ravenscar_Profile --
|
||||
---------------------------
|
||||
|
||||
-- The tasks to be done here are
|
||||
|
||||
-- Set required policies
|
||||
|
||||
-- pragma Task_Dispatching_Policy (FIFO_Within_Priorities)
|
||||
-- pragma Locking_Policy (Ceiling_Locking)
|
||||
|
||||
-- Set Detect_Blocking mode ???
|
||||
|
||||
-- Set required restrictions (see Restrict.Set_Ravenscar for details)
|
||||
|
||||
procedure Set_Ravenscar_Profile (N : Node_Id) is
|
||||
begin
|
||||
-- pragma Task_Dispatching_Policy (FIFO_Within_Priorities)
|
||||
|
||||
if Task_Dispatching_Policy /= ' '
|
||||
and then Task_Dispatching_Policy /= 'F'
|
||||
then
|
||||
Error_Msg_Sloc := Task_Dispatching_Policy_Sloc;
|
||||
Error_Pragma ("Profile (Ravenscar) incompatible with policy#");
|
||||
|
||||
-- Set the FIFO_Within_Priorities policy, but always
|
||||
-- preserve System_Location since we like the error
|
||||
-- message with the run time name.
|
||||
|
||||
else
|
||||
Task_Dispatching_Policy := 'F';
|
||||
|
||||
if Task_Dispatching_Policy_Sloc /= System_Location then
|
||||
Task_Dispatching_Policy_Sloc := Loc;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- pragma Locking_Policy (Ceiling_Locking)
|
||||
|
||||
if Locking_Policy /= ' '
|
||||
and then Locking_Policy /= 'C'
|
||||
then
|
||||
Error_Msg_Sloc := Locking_Policy_Sloc;
|
||||
Error_Pragma ("Profile (Ravenscar) incompatible with policy#");
|
||||
|
||||
-- Set the Ceiling_Locking policy, but always preserve
|
||||
-- System_Location since we like the error message with the
|
||||
-- run time name.
|
||||
|
||||
else
|
||||
Locking_Policy := 'C';
|
||||
|
||||
if Locking_Policy_Sloc /= System_Location then
|
||||
Locking_Policy_Sloc := Loc;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- ??? Detect_Blocking
|
||||
|
||||
-- Set the corresponding restrictions
|
||||
|
||||
Set_Ravenscar (N);
|
||||
end Set_Ravenscar_Profile;
|
||||
|
||||
-- Start of processing for Analyze_Pragma
|
||||
|
||||
begin
|
||||
@ -8005,13 +8075,12 @@ package body Sem_Prag is
|
||||
Check_Arg_Count (1);
|
||||
Check_Valid_Configuration_Pragma;
|
||||
Check_No_Identifiers;
|
||||
Set_Ravenscar (N);
|
||||
|
||||
declare
|
||||
Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
|
||||
begin
|
||||
if Chars (Argx) = Name_Ravenscar then
|
||||
Set_Ravenscar (N);
|
||||
Set_Ravenscar_Profile (N);
|
||||
else
|
||||
Error_Pragma_Arg ("& is not a valid profile", Argx);
|
||||
end if;
|
||||
@ -8481,7 +8550,7 @@ package body Sem_Prag is
|
||||
GNAT_Pragma;
|
||||
Check_Arg_Count (0);
|
||||
Check_Valid_Configuration_Pragma;
|
||||
Set_Ravenscar (N);
|
||||
Set_Ravenscar_Profile (N);
|
||||
|
||||
-------------------------
|
||||
-- Restricted_Run_Time --
|
||||
@ -9950,6 +10019,7 @@ package body Sem_Prag is
|
||||
-- Start of prorcessing for Is_Config_Static_String
|
||||
|
||||
begin
|
||||
|
||||
Name_Len := 0;
|
||||
return Add_Config_Static_String (Arg);
|
||||
end Is_Config_Static_String;
|
||||
@ -9965,6 +10035,7 @@ package body Sem_Prag is
|
||||
-- indicates that appearence in that parameter position is significant.
|
||||
|
||||
Sig_Flags : constant array (Pragma_Id) of Int :=
|
||||
|
||||
(Pragma_AST_Entry => -1,
|
||||
Pragma_Abort_Defer => -1,
|
||||
Pragma_Ada_83 => -1,
|
||||
@ -10095,7 +10166,7 @@ package body Sem_Prag is
|
||||
Pragma_Thread_Body => +2,
|
||||
Pragma_Time_Slice => -1,
|
||||
Pragma_Title => -1,
|
||||
Pragma_Unchecked_Union => -1,
|
||||
Pragma_Unchecked_Union => 0,
|
||||
Pragma_Unimplemented_Unit => -1,
|
||||
Pragma_Universal_Data => -1,
|
||||
Pragma_Unreferenced => -1,
|
||||
|
@ -3456,7 +3456,9 @@ package body Sem_Util is
|
||||
|
||||
-- Done if no more derivations to check
|
||||
|
||||
elsif T = T1 then
|
||||
elsif T = T1
|
||||
or else T = Etyp
|
||||
then
|
||||
return False;
|
||||
|
||||
-- Following test catches error cases resulting from prev errors
|
||||
@ -3471,11 +3473,7 @@ package body Sem_Util is
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- Return if no further entries to check
|
||||
|
||||
if T = Base_Type (T1) or else T = T1 then
|
||||
return False;
|
||||
end if;
|
||||
T := Base_Type (Etyp);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
@ -3927,7 +3925,9 @@ package body Sem_Util is
|
||||
return Attribute_Name (N) = Name_Input;
|
||||
|
||||
when N_Selected_Component =>
|
||||
return Is_Object_Reference (Selector_Name (N));
|
||||
return
|
||||
Is_Object_Reference (Selector_Name (N))
|
||||
and then Is_Object_Reference (Prefix (N));
|
||||
|
||||
when N_Explicit_Dereference =>
|
||||
return True;
|
||||
|
@ -4246,6 +4246,8 @@ package VMS_Data is
|
||||
-- UPPER_CASE
|
||||
|
||||
S_Pretty_Comments : aliased constant S := "/COMMENTS_LAYOUT=" &
|
||||
"UNTOUCHED " &
|
||||
"-c0 " &
|
||||
"DEFAULT " &
|
||||
"-c1 " &
|
||||
"STANDARD_INDENT " &
|
||||
@ -4256,17 +4258,20 @@ package VMS_Data is
|
||||
"-c4";
|
||||
-- /COMMENTS_LAYOUT[=layout-option, layout-option, ...]
|
||||
--
|
||||
-- Set the comment layout. By default, comments use the GNAT style comment
|
||||
-- line indentation.
|
||||
-- layout-option may be one of the following:
|
||||
-- Set the comment layout. By default, comments use the GNAT style
|
||||
-- comment line indentation.
|
||||
--
|
||||
-- layout-option is be one of the following:
|
||||
--
|
||||
-- UNTOUCHED All the comments remain unchanged
|
||||
-- DEFAULT (D) GNAT style comment line indentation
|
||||
-- STANDARD_INDENT Standard comment line indentation
|
||||
-- GNAT_BEGINNING GNAT style comment beginning
|
||||
-- REFORMAT Reformat comment blocks
|
||||
--
|
||||
-- All combinations of layout options are allowed, except for DEFAULT
|
||||
-- and STANDARD_INDENT which are mutually exclusive.
|
||||
-- and STANDARD_INDENT which are mutually exclusive, and also if
|
||||
-- UNTOUCHED is specified, this must be the only option.
|
||||
--
|
||||
-- The difference between "GNAT style comment line indentation" and
|
||||
-- "standard comment line indentation" is the following: for standard
|
||||
@ -4492,6 +4497,13 @@ package VMS_Data is
|
||||
--
|
||||
-- MIXED_CASE Names are in mixed case.
|
||||
|
||||
S_Pretty_No_Backup : aliased constant S := "/NO_BACKUP " &
|
||||
"-rnb";
|
||||
-- /REPLACE_NO_BACKUP
|
||||
--
|
||||
-- Replace the argument source with the pretty-printed source without
|
||||
-- creating any backup copy of the argument source.
|
||||
|
||||
S_Pretty_No_Labels : aliased constant S := "/NO_MISSED_LABELS " &
|
||||
"-e";
|
||||
-- /NO_MISSED_LABELS
|
||||
@ -4533,7 +4545,8 @@ package VMS_Data is
|
||||
"LOWER_CASE " &
|
||||
"-pL " &
|
||||
"UPPER_CASE " &
|
||||
-- /PRAGMA_CASING[=pragma-option]
|
||||
"-pU";
|
||||
-- /PRAGMA_CASING[=pragma-option]
|
||||
--
|
||||
-- Set the case of pragma identifiers. The default is Mixed case.
|
||||
-- pragma-option may be one of the following:
|
||||
@ -4541,9 +4554,9 @@ package VMS_Data is
|
||||
-- MIXED_CASE (D)
|
||||
-- LOWER_CASE
|
||||
-- UPPER_CASE
|
||||
"-pU";
|
||||
S_Pretty_Project : aliased constant S := "/PROJECT_FILE=<" &
|
||||
"-P>";
|
||||
|
||||
S_Pretty_Project : aliased constant S := "/PROJECT_FILE=<" &
|
||||
"-P>";
|
||||
-- /PROJECT_FILE=filename
|
||||
--
|
||||
-- Specifies the main project file to be used. The project files rooted
|
||||
@ -4621,6 +4634,7 @@ package VMS_Data is
|
||||
S_Pretty_Maxind 'Access,
|
||||
S_Pretty_Mess 'Access,
|
||||
S_Pretty_Names 'Access,
|
||||
S_Pretty_No_Backup 'Access,
|
||||
S_Pretty_No_Labels 'Access,
|
||||
S_Pretty_Notabs 'Access,
|
||||
S_Pretty_Output 'Access,
|
||||
|
Loading…
Reference in New Issue
Block a user