[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>
|
2004-05-24 Geert Bosch <bosch@gnat.com>
|
||||||
|
|
||||||
* a-numaux-x86.adb (Reduce): Reimplement using an approximation of Pi
|
* a-numaux-x86.adb (Reduce): Reimplement using an approximation of Pi
|
||||||
|
|
|
@ -1260,6 +1260,7 @@ endif
|
||||||
ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
|
ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
|
||||||
LIBGNAT_TARGET_PAIRS = \
|
LIBGNAT_TARGET_PAIRS = \
|
||||||
a-intnam.ads<a-intnam-linux.ads \
|
a-intnam.ads<a-intnam-linux.ads \
|
||||||
|
a-numaux.ads<a-numaux-libc-x86.ads \
|
||||||
s-inmaop.adb<s-inmaop-posix.adb \
|
s-inmaop.adb<s-inmaop-posix.adb \
|
||||||
s-intman.adb<s-intman-posix.adb \
|
s-intman.adb<s-intman-posix.adb \
|
||||||
s-osinte.ads<s-osinte-linux.ads \
|
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
|
-- 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
|
-- 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
|
-- 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.
|
-- of an access parameter or an allocator.
|
||||||
--
|
--
|
||||||
-- Note: this flag is set according to the sequential flow of the
|
-- Note: this flag is set according to the sequential flow of the
|
||||||
-- program, watching the current value of the variable. However,
|
-- 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
|
-- 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 believed if the variable is aliased or volatile. It would
|
||||||
-- be a little neater to avoid the flag being set in the first
|
-- 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
|
-- Reset overflow flag, since the range check will include
|
||||||
-- dealing with possible overflow, and generate the check
|
-- 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);
|
Set_Do_Overflow_Check (N, False);
|
||||||
Generate_Range_Check
|
if not Is_Descendent_Of_Address (Etype (Expr))
|
||||||
(Expr, Target_Type, CE_Range_Check_Failed);
|
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 if;
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
@ -6288,7 +6295,17 @@ package body Exp_Ch4 is
|
||||||
Val <= Expr_Value (Type_High_Bound (Target_Type))
|
Val <= Expr_Value (Type_High_Bound (Target_Type))
|
||||||
then
|
then
|
||||||
Rewrite (N, Make_Integer_Literal (Sloc (N), Val));
|
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;
|
return;
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
|
|
|
@ -1833,10 +1833,27 @@ package body Exp_Ch6 is
|
||||||
Subp := Parent_Subp;
|
Subp := Parent_Subp;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Check for violation of No_Abort_Statements
|
||||||
|
|
||||||
if Is_RTE (Subp, RE_Abort_Task) then
|
if Is_RTE (Subp, RE_Abort_Task) then
|
||||||
Check_Restriction (No_Abort_Statements, N);
|
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;
|
end if;
|
||||||
|
|
||||||
|
-- Deal with case where call is an explicit dereference
|
||||||
|
|
||||||
if Nkind (Name (N)) = N_Explicit_Dereference then
|
if Nkind (Name (N)) = N_Explicit_Dereference then
|
||||||
|
|
||||||
-- Handle case of access to protected subprogram type
|
-- Handle case of access to protected subprogram type
|
||||||
|
@ -3189,7 +3206,7 @@ package body Exp_Ch6 is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
while Present (F) loop
|
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);
|
Set_Is_Pure (Spec_Id, False);
|
||||||
|
|
||||||
if Spec_Id /= Body_Id then
|
if Spec_Id /= Body_Id then
|
||||||
|
|
|
@ -151,10 +151,10 @@ Implementation Defined Pragmas
|
||||||
* Pragma Obsolescent::
|
* Pragma Obsolescent::
|
||||||
* Pragma Passive::
|
* Pragma Passive::
|
||||||
* Pragma Polling::
|
* Pragma Polling::
|
||||||
|
* Pragma Profile (Ravenscar)::
|
||||||
* Pragma Propagate_Exceptions::
|
* Pragma Propagate_Exceptions::
|
||||||
* Pragma Psect_Object::
|
* Pragma Psect_Object::
|
||||||
* Pragma Pure_Function::
|
* Pragma Pure_Function::
|
||||||
* Pragma Ravenscar::
|
|
||||||
* Pragma Restricted_Run_Time::
|
* Pragma Restricted_Run_Time::
|
||||||
* Pragma Restriction_Warnings::
|
* Pragma Restriction_Warnings::
|
||||||
* Pragma Source_File_Name::
|
* Pragma Source_File_Name::
|
||||||
|
@ -641,10 +641,10 @@ consideration, the use of these pragmas should be minimized.
|
||||||
* Pragma Obsolescent::
|
* Pragma Obsolescent::
|
||||||
* Pragma Passive::
|
* Pragma Passive::
|
||||||
* Pragma Polling::
|
* Pragma Polling::
|
||||||
|
* Pragma Profile (Ravenscar)::
|
||||||
* Pragma Propagate_Exceptions::
|
* Pragma Propagate_Exceptions::
|
||||||
* Pragma Psect_Object::
|
* Pragma Psect_Object::
|
||||||
* Pragma Pure_Function::
|
* Pragma Pure_Function::
|
||||||
* Pragma Ravenscar::
|
|
||||||
* Pragma Restricted_Run_Time::
|
* Pragma Restricted_Run_Time::
|
||||||
* Pragma Restriction_Warnings::
|
* Pragma Restriction_Warnings::
|
||||||
* Pragma Source_File_Name::
|
* 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
|
Note that polling can also be enabled by use of the @code{-gnatP} switch. See
|
||||||
the @cite{GNAT User's Guide} for details.
|
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
|
@node Pragma Propagate_Exceptions
|
||||||
@unnumberedsec Pragma Propagate_Exceptions
|
@unnumberedsec Pragma Propagate_Exceptions
|
||||||
@findex 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
|
disambiguate cases of overloading where some but not all functions
|
||||||
in a set of overloaded functions are to be designated as pure.
|
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
|
@node Pragma Restricted_Run_Time
|
||||||
@unnumberedsec Pragma Restricted_Run_Time
|
@unnumberedsec Pragma Restricted_Run_Time
|
||||||
@findex 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_Task_Allocators
|
||||||
@item No_Dynamic_Priorities
|
@item No_Dynamic_Priorities
|
||||||
@item No_Terminate_Alternatives
|
@item No_Terminate_Alternatives
|
||||||
@item No_Dynamic_Interrupts
|
@item No_Dynamic_Attachment
|
||||||
@item No_Protected_Type_Allocators
|
@item No_Protected_Type_Allocators
|
||||||
@item No_Local_Protected_Objects
|
@item No_Local_Protected_Objects
|
||||||
@item No_Requeue_Statements
|
@item No_Requeue_Statements
|
||||||
|
@ -5984,8 +6008,8 @@ restrictions to produce a more efficient implementation.
|
||||||
@end cartouche
|
@end cartouche
|
||||||
GNAT currently takes advantage of these restrictions by providing an optimized
|
GNAT currently takes advantage of these restrictions by providing an optimized
|
||||||
run time when the Ravenscar profile and the GNAT restricted run time set
|
run time when the Ravenscar profile and the GNAT restricted run time set
|
||||||
of restrictions are specified. See pragma @code{Ravenscar} and pragma
|
of restrictions are specified. See pragma @code{Profile (Ravenscar)} and
|
||||||
@code{Restricted_Run_Time} for more details.
|
pragma @code{Restricted_Run_Time} for more details.
|
||||||
|
|
||||||
@cindex Time, monotonic
|
@cindex Time, monotonic
|
||||||
@unnumberedsec D.8(47-49): Monotonic Time
|
@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
|
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
|
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
|
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
|
@item Max_Entry_Queue_Length => Expr
|
||||||
@findex Max_Entry_Queue_Depth
|
@findex Max_Entry_Queue_Length
|
||||||
This restriction is a declaration that any protected entry compiled in
|
This restriction is a declaration that any protected entry compiled in
|
||||||
the scope of the restriction has at most the specified number of
|
the scope of the restriction has at most the specified number of
|
||||||
tasks waiting on the entry
|
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
|
where the certification protocol requires the use of short-circuit
|
||||||
(and then, or else) forms for all composite boolean operations.
|
(and then, or else) forms for all composite boolean operations.
|
||||||
|
|
||||||
@item No_Dynamic_Interrupts
|
@item No_Dynamic_Attachment
|
||||||
@findex No_Dynamic_Interrupts
|
@findex No_Dynamic_Attachment
|
||||||
This restriction ensures at compile time that there is no attempt to
|
This restriction ensures that there is no call to any of the operations
|
||||||
dynamically associate interrupts. Only static association is allowed.
|
defined in package Ada.Interrupts.
|
||||||
|
|
||||||
@item No_Enumeration_Maps
|
@item No_Enumeration_Maps
|
||||||
@findex 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
|
This restriction ensures at compile time no select statements of any kind
|
||||||
are permitted, that is the keyword @code{select} may not appear.
|
are permitted, that is the keyword @code{select} may not appear.
|
||||||
This is one of the restrictions of the Ravenscar
|
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
|
@item No_Standard_Storage_Pools
|
||||||
@findex No_Standard_Storage_Pools
|
@findex No_Standard_Storage_Pools
|
||||||
|
|
|
@ -9995,9 +9995,9 @@ recognized by @code{GNAT}:
|
||||||
Long_Float
|
Long_Float
|
||||||
Normalize_Scalars
|
Normalize_Scalars
|
||||||
Polling
|
Polling
|
||||||
|
Profile
|
||||||
Propagate_Exceptions
|
Propagate_Exceptions
|
||||||
Queuing_Policy
|
Queuing_Policy
|
||||||
Ravenscar
|
|
||||||
Restricted_Run_Time
|
Restricted_Run_Time
|
||||||
Restrictions
|
Restrictions
|
||||||
Reviewable
|
Reviewable
|
||||||
|
@ -14647,6 +14647,9 @@ on their effect.
|
||||||
|
|
||||||
@table @option
|
@table @option
|
||||||
@cindex @option{^-c@var{n}^/COMMENTS_LAYOUT^} (@command{gnatpp})
|
@cindex @option{^-c@var{n}^/COMMENTS_LAYOUT^} (@command{gnatpp})
|
||||||
|
@item ^-c0^/COMMENTS_LAYOUT=UNTOUCHED^
|
||||||
|
All the comments remain unchanged
|
||||||
|
|
||||||
@item ^-c1^/COMMENTS_LAYOUT=DEFAULT^
|
@item ^-c1^/COMMENTS_LAYOUT=DEFAULT^
|
||||||
GNAT-style comment line indentation (this is the default).
|
GNAT-style comment line indentation (this is the default).
|
||||||
|
|
||||||
|
@ -14680,7 +14683,8 @@ stops.
|
||||||
@noindent
|
@noindent
|
||||||
The @option{-c1} and @option{-c2} switches are incompatible.
|
The @option{-c1} and @option{-c2} switches are incompatible.
|
||||||
The @option{-c3} and @option{-c4} switches are compatible with each other and
|
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.
|
The @option{-l1}, @option{-l2}, and @option{-l3} switches are incompatible.
|
||||||
@end ifclear
|
@end ifclear
|
||||||
|
@ -14827,6 +14831,11 @@ reading or processing the input file.
|
||||||
@cindex @option{^-rf^/OVERRIDING_REPLACE^} (@code{gnatpp})
|
@cindex @option{^-rf^/OVERRIDING_REPLACE^} (@code{gnatpp})
|
||||||
Like @option{^-r^/REPLACE^} except that if the file with the specified name
|
Like @option{^-r^/REPLACE^} except that if the file with the specified name
|
||||||
already exists, it is overwritten.
|
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
|
@end table
|
||||||
|
|
||||||
@noindent
|
@noindent
|
||||||
|
|
|
@ -32,13 +32,12 @@
|
||||||
{"@ada",
|
{"@ada",
|
||||||
"\
|
"\
|
||||||
%{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
|
%{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
|
||||||
%{!gnatc*:%{!gnats*:%{!S:%{!c:\
|
%{!S:%{!c:%e-c or -S required for Ada}}\
|
||||||
%eone of -c, -S, -gnatc or -gnats is required for Ada}}}}\
|
|
||||||
gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %1 %{!Q:-quiet} %{nostdinc*}\
|
gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %1 %{!Q:-quiet} %{nostdinc*}\
|
||||||
%{nostdlib*}\
|
%{nostdlib*}\
|
||||||
-dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
|
-dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
|
||||||
%{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\
|
%{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\
|
||||||
%{!S:%{o*:%w%*-gnatO}} \
|
%{!S:%{o*:%w%*-gnatO}} \
|
||||||
%i %{S:%W{o*}%{!o*:-o %b.s}} \
|
%i %{S:%W{o*}%{!o*:-o %b.s}} \
|
||||||
%{!S:%{gnatc*|gnats*: -o %j}} \
|
%{gnatc*|gnats*: -o %j} \
|
||||||
%{!gnatc*:%{!gnats*:%(invoke_as)}}", 0, 0, 0},
|
%{!gnatc*:%{!gnats*:%(invoke_as)}}", 0, 0, 0},
|
||||||
|
|
|
@ -269,6 +269,27 @@ package body Lib.Xref is
|
||||||
then
|
then
|
||||||
null;
|
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
|
-- Any other occurrence counts as referencing the entity
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
|
@ -147,8 +147,8 @@ package body Rtsfind is
|
||||||
Use_Setting : Boolean := False);
|
Use_Setting : Boolean := False);
|
||||||
-- Load the unit whose Id is given if not already loaded. The unit is
|
-- 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
|
-- loaded, analyzed, and added to the WITH list, and the entry in
|
||||||
-- RT_Unit_Table is updated to reflect the load. The second parameter
|
-- RT_Unit_Table is updated to reflect the load. Use_Setting is used
|
||||||
-- indicates the initial setting for the Is_Potentially_Use_Visible
|
-- to indicate the initial setting for the Is_Potentially_Use_Visible
|
||||||
-- flag of the entity for the loaded unit (if it is indeed loaded).
|
-- 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
|
-- 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
|
-- 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
|
function RTU_Loaded (U : RTU_Id) return Boolean is
|
||||||
begin
|
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;
|
end RTU_Loaded;
|
||||||
|
|
||||||
--------------------
|
--------------------
|
||||||
|
|
|
@ -450,6 +450,13 @@ package Rtsfind is
|
||||||
RE_List_Controller, -- Ada.Finalization.List_Controller
|
RE_List_Controller, -- Ada.Finalization.List_Controller
|
||||||
|
|
||||||
RE_Interrupt_ID, -- Ada.Interrupts
|
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
|
RE_Names, -- Ada.Interupts.Names
|
||||||
|
|
||||||
|
@ -1522,6 +1529,13 @@ package Rtsfind is
|
||||||
RE_List_Controller => Ada_Finalization_List_Controller,
|
RE_List_Controller => Ada_Finalization_List_Controller,
|
||||||
|
|
||||||
RE_Interrupt_ID => Ada_Interrupts,
|
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,
|
RE_Names => Ada_Interrupts_Names,
|
||||||
|
|
||||||
|
|
|
@ -305,9 +305,8 @@ package body System.Interrupts is
|
||||||
-- Bind_Interrupt_To_Entry --
|
-- Bind_Interrupt_To_Entry --
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
||||||
-- This procedure raises a Program_Error if it tries to
|
-- This procedure raises a Program_Error if it tries to bind an
|
||||||
-- bind an interrupt to which an Entry or a Procedure is
|
-- interrupt to which an Entry or a Procedure is already bound.
|
||||||
-- already bound.
|
|
||||||
|
|
||||||
procedure Bind_Interrupt_To_Entry
|
procedure Bind_Interrupt_To_Entry
|
||||||
(T : Task_Id;
|
(T : Task_Id;
|
||||||
|
@ -315,7 +314,7 @@ package body System.Interrupts is
|
||||||
Int_Ref : System.Address)
|
Int_Ref : System.Address)
|
||||||
is
|
is
|
||||||
Interrupt : constant Interrupt_ID :=
|
Interrupt : constant Interrupt_ID :=
|
||||||
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
|
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Is_Reserved (Interrupt) then
|
if Is_Reserved (Interrupt) then
|
||||||
|
@ -324,7 +323,6 @@ package body System.Interrupts is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
|
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
|
||||||
|
|
||||||
end Bind_Interrupt_To_Entry;
|
end Bind_Interrupt_To_Entry;
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
|
@ -383,7 +381,6 @@ package body System.Interrupts is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Interrupt_Manager.Detach_Handler (Interrupt, Static);
|
Interrupt_Manager.Detach_Handler (Interrupt, Static);
|
||||||
|
|
||||||
end Detach_Handler;
|
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
|
-- previous handler's binding status (ie. do not care if it is a
|
||||||
-- dynamic or static handler).
|
-- dynamic or static handler).
|
||||||
|
|
||||||
-- This option is needed so that during the finalization of a PO, we
|
-- This option is needed so that during the finalization of a PO,
|
||||||
-- can detach handlers attached through pragma Attach_Handler.
|
-- we can detach handlers attached through pragma Attach_Handler.
|
||||||
|
|
||||||
procedure Exchange_Handler
|
procedure Exchange_Handler
|
||||||
(Old_Handler : out Parameterless_Handler;
|
(Old_Handler : out Parameterless_Handler;
|
||||||
|
@ -421,12 +418,11 @@ package body System.Interrupts is
|
||||||
|
|
||||||
Interrupt_Manager.Exchange_Handler
|
Interrupt_Manager.Exchange_Handler
|
||||||
(Old_Handler, New_Handler, Interrupt, Static);
|
(Old_Handler, New_Handler, Interrupt, Static);
|
||||||
|
|
||||||
end Exchange_Handler;
|
end Exchange_Handler;
|
||||||
|
|
||||||
----------------
|
--------------
|
||||||
-- Finalize --
|
-- Finalize --
|
||||||
----------------
|
--------------
|
||||||
|
|
||||||
procedure Finalize (Object : in out Static_Interrupt_Protection) is
|
procedure Finalize (Object : in out Static_Interrupt_Protection) is
|
||||||
begin
|
begin
|
||||||
|
@ -451,7 +447,7 @@ package body System.Interrupts is
|
||||||
-- Has_Interrupt_Or_Attach_Handler --
|
-- 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
|
function Has_Interrupt_Or_Attach_Handler
|
||||||
(Object : access Dynamic_Interrupt_Protection) return Boolean
|
(Object : access Dynamic_Interrupt_Protection) return Boolean
|
||||||
|
@ -602,7 +598,6 @@ package body System.Interrupts is
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
return False;
|
return False;
|
||||||
|
|
||||||
end Is_Registered;
|
end Is_Registered;
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
|
@ -804,7 +799,6 @@ package body System.Interrupts is
|
||||||
else
|
else
|
||||||
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
end Unbind_Handler;
|
end Unbind_Handler;
|
||||||
|
|
||||||
--------------------------------
|
--------------------------------
|
||||||
|
@ -832,6 +826,7 @@ package body System.Interrupts is
|
||||||
-- status of the current_Handler.
|
-- status of the current_Handler.
|
||||||
|
|
||||||
if not Static and then User_Handler (Interrupt).Static then
|
if not Static and then User_Handler (Interrupt).Static then
|
||||||
|
|
||||||
-- Tries to detach a static Interrupt Handler.
|
-- Tries to detach a static Interrupt Handler.
|
||||||
-- raise a program error.
|
-- raise a program error.
|
||||||
|
|
||||||
|
@ -854,7 +849,6 @@ package body System.Interrupts is
|
||||||
if Old_Handler /= null then
|
if Old_Handler /= null then
|
||||||
Unbind_Handler (Interrupt);
|
Unbind_Handler (Interrupt);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
end Unprotected_Detach_Handler;
|
end Unprotected_Detach_Handler;
|
||||||
|
|
||||||
----------------------------------
|
----------------------------------
|
||||||
|
@ -866,7 +860,8 @@ package body System.Interrupts is
|
||||||
New_Handler : Parameterless_Handler;
|
New_Handler : Parameterless_Handler;
|
||||||
Interrupt : Interrupt_ID;
|
Interrupt : Interrupt_ID;
|
||||||
Static : Boolean;
|
Static : Boolean;
|
||||||
Restoration : Boolean := False) is
|
Restoration : Boolean := False)
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
if User_Entry (Interrupt).T /= Null_Task then
|
if User_Entry (Interrupt).T /= Null_Task then
|
||||||
|
|
||||||
|
@ -951,7 +946,6 @@ package body System.Interrupts is
|
||||||
if Old_Handler = null then
|
if Old_Handler = null then
|
||||||
Bind_Handler (Interrupt);
|
Bind_Handler (Interrupt);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
end Unprotected_Exchange_Handler;
|
end Unprotected_Exchange_Handler;
|
||||||
|
|
||||||
-- Start of processing for Interrupt_Manager
|
-- Start of processing for Interrupt_Manager
|
||||||
|
@ -1081,6 +1075,7 @@ package body System.Interrupts is
|
||||||
-- Place Task_Id info in Server_ID array.
|
-- Place Task_Id info in Server_ID array.
|
||||||
|
|
||||||
if Server_ID (Interrupt) = Null_Task then
|
if Server_ID (Interrupt) = Null_Task then
|
||||||
|
|
||||||
-- When a new Server_Task is created, it should have its
|
-- When a new Server_Task is created, it should have its
|
||||||
-- signal mask set to the All_Tasks_Mask.
|
-- signal mask set to the All_Tasks_Mask.
|
||||||
|
|
||||||
|
@ -1100,6 +1095,7 @@ package body System.Interrupts is
|
||||||
for J in Interrupt_ID'Range loop
|
for J in Interrupt_ID'Range loop
|
||||||
if not Is_Reserved (J) then
|
if not Is_Reserved (J) then
|
||||||
if User_Entry (J).T = T then
|
if User_Entry (J).T = T then
|
||||||
|
|
||||||
-- The interrupt should no longer be ingnored if
|
-- The interrupt should no longer be ingnored if
|
||||||
-- it was ever ignored.
|
-- it was ever ignored.
|
||||||
|
|
||||||
|
@ -1111,7 +1107,7 @@ package body System.Interrupts is
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
-- Indicate in ATCB that no Interrupt Entries are attached.
|
-- Indicate in ATCB that no Interrupt Entries are attached
|
||||||
|
|
||||||
T.Interrupt_Entry := False;
|
T.Interrupt_Entry := False;
|
||||||
end Detach_Interrupt_Entries;
|
end Detach_Interrupt_Entries;
|
||||||
|
@ -1133,10 +1129,10 @@ package body System.Interrupts is
|
||||||
if User_Handler (Interrupt).H /= null
|
if User_Handler (Interrupt).H /= null
|
||||||
or else User_Entry (Interrupt).T /= Null_Task
|
or else User_Entry (Interrupt).T /= Null_Task
|
||||||
then
|
then
|
||||||
-- This is the case where the Server_Task is waiting on
|
-- This is the case where the Server_Task is waiting
|
||||||
-- "sigwait." Wake it up by sending an
|
-- on "sigwait." Wake it up by sending an
|
||||||
-- Abort_Task_Interrupt so that the Server_Task waits on
|
-- Abort_Task_Interrupt so that the Server_Task
|
||||||
-- Cond.
|
-- waits on Cond.
|
||||||
|
|
||||||
POP.Abort_Task (Server_ID (Interrupt));
|
POP.Abort_Task (Server_ID (Interrupt));
|
||||||
|
|
||||||
|
@ -1166,6 +1162,7 @@ package body System.Interrupts is
|
||||||
then
|
then
|
||||||
-- No handler is attached. Unmask the Interrupt so that
|
-- No handler is attached. Unmask the Interrupt so that
|
||||||
-- the default action can be carried out.
|
-- the default action can be carried out.
|
||||||
|
|
||||||
IMOP.Thread_Unblock_Interrupt
|
IMOP.Thread_Unblock_Interrupt
|
||||||
(IMNG.Interrupt_ID (Interrupt));
|
(IMNG.Interrupt_ID (Interrupt));
|
||||||
|
|
||||||
|
@ -1174,6 +1171,7 @@ package body System.Interrupts is
|
||||||
-- since it was being blocked and an Interrupt Hander or
|
-- since it was being blocked and an Interrupt Hander or
|
||||||
-- an Entry was there. Wake it up and let it change
|
-- an Entry was there. Wake it up and let it change
|
||||||
-- it place of waiting according to its new state.
|
-- it place of waiting according to its new state.
|
||||||
|
|
||||||
POP.Wakeup (Server_ID (Interrupt),
|
POP.Wakeup (Server_ID (Interrupt),
|
||||||
Interrupt_Server_Blocked_Interrupt_Sleep);
|
Interrupt_Server_Blocked_Interrupt_Sleep);
|
||||||
end if;
|
end if;
|
||||||
|
@ -1356,69 +1354,78 @@ package body System.Interrupts is
|
||||||
POP.Write_Lock (Self_ID);
|
POP.Write_Lock (Self_ID);
|
||||||
|
|
||||||
else
|
else
|
||||||
pragma Assert (Ret_Interrupt = Interrupt);
|
|
||||||
|
|
||||||
if Single_Lock then
|
if Single_Lock then
|
||||||
POP.Lock_RTS;
|
POP.Lock_RTS;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
POP.Write_Lock (Self_ID);
|
POP.Write_Lock (Self_ID);
|
||||||
|
|
||||||
-- Even though we have received an Interrupt the status may
|
if Ret_Interrupt /= Interrupt then
|
||||||
-- 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 User_Handler (Interrupt).H /= null then
|
-- On some systems (e.g. recent linux kernels), sigwait
|
||||||
Tmp_Handler := User_Handler (Interrupt).H;
|
-- may return unexpectedly (with errno set to EINTR).
|
||||||
|
|
||||||
-- RTS calls should not be made with self being locked.
|
null;
|
||||||
|
|
||||||
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
|
else
|
||||||
-- This is a situation that this task wake up
|
-- Even though we have received an Interrupt the status may
|
||||||
-- receiving an Interrupt and before it get the lock
|
-- have changed already before we got the Self_ID lock above
|
||||||
-- the Interrupt is blocked. We do not
|
-- Therefore we make sure a Handler or an Entry is still
|
||||||
-- want to lose the interrupt in this case so that
|
-- there and make appropriate call.
|
||||||
-- regenerate the Interrupt to process level;
|
|
||||||
|
|
||||||
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;
|
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
|
-- Undefer abort here to allow a window for this task
|
||||||
-- to be aborted at the time of system shutdown.
|
-- to be aborted at the time of system shutdown.
|
||||||
|
|
||||||
end loop;
|
end loop;
|
||||||
end Server_Task;
|
end Server_Task;
|
||||||
|
|
||||||
-- Elaboration code for package System.Interrupts
|
-- Elaboration code for package System.Interrupts
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
-- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
|
-- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
|
||||||
|
|
||||||
Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
|
Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
|
||||||
|
|
||||||
-- During the elaboration of this package body we want RTS to
|
-- During the elaboration of this package body we want the RTS
|
||||||
-- inherit the interrupt mask from the Environment Task.
|
-- 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
|
-- the enclosing process during the RTS start up. (See
|
||||||
-- in s-inmaop.adb). Pass the Interrupt_Mask of the Environment
|
-- processing in s-inmaop.adb). Pass the Interrupt_Mask
|
||||||
-- task to the Interrupt_Manager.
|
-- of the environment task to the Interrupt_Manager.
|
||||||
|
|
||||||
-- Note : At this point we know that all tasks (including
|
-- Note : At this point we know that all tasks (including
|
||||||
-- RTS internal servers) are masked for non-reserved signals
|
-- RTS internal servers) are masked for non-reserved signals
|
||||||
-- (see s-taprop.adb). Only the Interrupt_Manager will have
|
-- (see s-taprop.adb). Only the Interrupt_Manager will have
|
||||||
-- masks set up differently inheriting the original Environment
|
-- masks set up differently inheriting the original environment
|
||||||
-- Task's mask.
|
-- task's mask.
|
||||||
|
|
||||||
Interrupt_Manager.Initialize (IMOP.Environment_Mask);
|
Interrupt_Manager.Initialize (IMOP.Environment_Mask);
|
||||||
end System.Interrupts;
|
end System.Interrupts;
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- S p e c --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -347,20 +347,22 @@ package Sem is
|
||||||
-- Handling of Check Suppression --
|
-- Handling of Check Suppression --
|
||||||
-----------------------------------
|
-----------------------------------
|
||||||
|
|
||||||
-- There are two kinds of suppress checks, scope based suppress checks
|
-- There are two kinds of suppress checks: scope based suppress checks,
|
||||||
-- (from initial command line arguments, or from Suppress pragmas not
|
-- and entity based suppress checks.
|
||||||
-- including an entity name). The scope based suppress checks are recorded
|
|
||||||
|
-- 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
|
-- 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.
|
-- 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
|
-- Entity based suppress checks, from Suppress pragmas giving an Entity_Id,
|
||||||
-- Suppress pragmas giving an Entity_Id. These are handled as follows. If
|
-- are handled as follows. If a suppress or unsuppress pragma is
|
||||||
-- a suppress or unsuppress pragma is encountered for a given entity, then
|
-- encountered for a given entity, then the flag Checks_May_Be_Suppressed
|
||||||
-- the flag Checks_May_Be_Suppressed is set in the entity and an entry is
|
-- is set in the entity and an entry is made in either the
|
||||||
-- made in either the Local_Entity_Suppress table (case of pragma that
|
-- Local_Entity_Suppress table (case of pragma that appears in other than
|
||||||
-- appears in other than a package spec), or in the Global_Entity_Suppress
|
-- a package spec), or in the Global_Entity_Suppress table (case of pragma
|
||||||
-- table (case of pragma that appears in a package spec, which is by the
|
-- that appears in a package spec, which is by the rule of RM 11.5(7)
|
||||||
-- rule of RM 11.5(7) applicable throughout the life of the entity).
|
-- applicable throughout the life of the entity).
|
||||||
|
|
||||||
-- If the Checks_May_Be_Suppressed flag is set in an entity then the
|
-- 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
|
-- 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
|
-- Common error routine for mismatch between the parameters of
|
||||||
-- the actual instance and those of the formal package.
|
-- 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
|
-- The formal may come from a nested formal package, and the actual
|
||||||
-- may have been constant-folded. To determine whether the two denote
|
-- may have been constant-folded. To determine whether the two denote
|
||||||
-- the same entity we may have to traverse several definitions to
|
-- the same entity we may have to traverse several definitions to
|
||||||
-- recover the ultimate entity that they refer 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 --
|
-- Check_Mismatch --
|
||||||
--------------------
|
--------------------
|
||||||
|
@ -3655,13 +3660,14 @@ package body Sem_Ch12 is
|
||||||
end if;
|
end if;
|
||||||
end Check_Mismatch;
|
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;
|
Ent : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Ent := E2;
|
Ent := E2;
|
||||||
while Present (Ent) loop
|
while Present (Ent) loop
|
||||||
|
@ -3689,7 +3695,43 @@ package body Sem_Ch12 is
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
return False;
|
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
|
-- Start of processing for Check_Formal_Package_Instance
|
||||||
|
|
||||||
|
@ -3768,13 +3810,10 @@ package body Sem_Ch12 is
|
||||||
if Is_Entity_Name (Expr2) then
|
if Is_Entity_Name (Expr2) then
|
||||||
if Entity (Expr1) = Entity (Expr2) then
|
if Entity (Expr1) = Entity (Expr2) then
|
||||||
null;
|
null;
|
||||||
|
|
||||||
elsif
|
|
||||||
Same_Instantiated_Entity (Entity (Expr1), Entity (Expr2))
|
|
||||||
then
|
|
||||||
null;
|
|
||||||
else
|
else
|
||||||
Check_Mismatch (True);
|
Check_Mismatch
|
||||||
|
(not Same_Instantiated_Constant
|
||||||
|
(Entity (Expr1), Entity (Expr2)));
|
||||||
end if;
|
end if;
|
||||||
else
|
else
|
||||||
Check_Mismatch (True);
|
Check_Mismatch (True);
|
||||||
|
@ -3783,7 +3822,7 @@ package body Sem_Ch12 is
|
||||||
elsif Is_Entity_Name (Original_Node (Expr1))
|
elsif Is_Entity_Name (Original_Node (Expr1))
|
||||||
and then Is_Entity_Name (Expr2)
|
and then Is_Entity_Name (Expr2)
|
||||||
and then
|
and then
|
||||||
Same_Instantiated_Entity
|
Same_Instantiated_Constant
|
||||||
(Entity (Original_Node (Expr1)), Entity (Expr2))
|
(Entity (Original_Node (Expr1)), Entity (Expr2))
|
||||||
then
|
then
|
||||||
null;
|
null;
|
||||||
|
@ -3795,9 +3834,10 @@ package body Sem_Ch12 is
|
||||||
Check_Mismatch (True);
|
Check_Mismatch (True);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
elsif Ekind (E1) = E_Variable
|
elsif Ekind (E1) = E_Variable then
|
||||||
or else Ekind (E1) = E_Package
|
Check_Mismatch (not Same_Instantiated_Variable (E1, E2));
|
||||||
then
|
|
||||||
|
elsif Ekind (E1) = E_Package then
|
||||||
Check_Mismatch
|
Check_Mismatch
|
||||||
(Ekind (E1) /= Ekind (E2)
|
(Ekind (E1) /= Ekind (E2)
|
||||||
or else Renamed_Object (E1) /= Renamed_Object (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
|
if Nkind (Gen_Body) = N_Subprogram_Body_Stub then
|
||||||
|
|
||||||
-- Either body is not present, or context is non-expanding, as
|
-- 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);
|
Set_Has_Completion (Anon_Id);
|
||||||
return;
|
return;
|
||||||
|
|
|
@ -4361,6 +4361,7 @@ package body Sem_Ch4 is
|
||||||
-- truly hidden.
|
-- truly hidden.
|
||||||
|
|
||||||
type Operand_Position is (First_Op, Second_Op);
|
type Operand_Position is (First_Op, Second_Op);
|
||||||
|
Univ_Type : constant Entity_Id := Universal_Interpretation (N);
|
||||||
|
|
||||||
procedure Remove_Address_Interpretations (Op : Operand_Position);
|
procedure Remove_Address_Interpretations (Op : Operand_Position);
|
||||||
-- Ambiguities may arise when the operands are literal and the
|
-- Ambiguities may arise when the operands are literal and the
|
||||||
|
@ -4451,6 +4452,25 @@ package body Sem_Ch4 is
|
||||||
Remove_Interp (I);
|
Remove_Interp (I);
|
||||||
end if;
|
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);
|
Get_Next_Interp (I, It);
|
||||||
end loop;
|
end loop;
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -561,6 +561,12 @@ package body Sem_Prag is
|
||||||
-- argument has the right form then the Mechanism field of Ent is
|
-- argument has the right form then the Mechanism field of Ent is
|
||||||
-- set appropriately.
|
-- 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 --
|
-- Check_Ada_83_Warning --
|
||||||
--------------------------
|
--------------------------
|
||||||
|
@ -3257,8 +3263,7 @@ package body Sem_Prag is
|
||||||
Val : Uint;
|
Val : Uint;
|
||||||
|
|
||||||
procedure Set_Warning (R : All_Restrictions);
|
procedure Set_Warning (R : All_Restrictions);
|
||||||
-- If this is a Restriction_Warnings pragma, set warning flag,
|
-- If this is a Restriction_Warnings pragma, set warning flag
|
||||||
-- otherwise flag gets cleared.
|
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
-- Set_Warning --
|
-- Set_Warning --
|
||||||
|
@ -3266,8 +3271,9 @@ package body Sem_Prag is
|
||||||
|
|
||||||
procedure Set_Warning (R : All_Restrictions) is
|
procedure Set_Warning (R : All_Restrictions) is
|
||||||
begin
|
begin
|
||||||
Restriction_Warnings (R) :=
|
if Prag_Id = Pragma_Restriction_Warnings then
|
||||||
Prag_Id = Pragma_Restriction_Warnings;
|
Restriction_Warnings (R) := True;
|
||||||
|
end if;
|
||||||
end Set_Warning;
|
end Set_Warning;
|
||||||
|
|
||||||
-- Start of processing for Process_Restrictions_Or_Restriction_Warnings
|
-- Start of processing for Process_Restrictions_Or_Restriction_Warnings
|
||||||
|
@ -3821,6 +3827,70 @@ package body Sem_Prag is
|
||||||
|
|
||||||
end Set_Mechanism_Value;
|
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
|
-- Start of processing for Analyze_Pragma
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
@ -8005,13 +8075,12 @@ package body Sem_Prag is
|
||||||
Check_Arg_Count (1);
|
Check_Arg_Count (1);
|
||||||
Check_Valid_Configuration_Pragma;
|
Check_Valid_Configuration_Pragma;
|
||||||
Check_No_Identifiers;
|
Check_No_Identifiers;
|
||||||
Set_Ravenscar (N);
|
|
||||||
|
|
||||||
declare
|
declare
|
||||||
Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
|
Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
|
||||||
begin
|
begin
|
||||||
if Chars (Argx) = Name_Ravenscar then
|
if Chars (Argx) = Name_Ravenscar then
|
||||||
Set_Ravenscar (N);
|
Set_Ravenscar_Profile (N);
|
||||||
else
|
else
|
||||||
Error_Pragma_Arg ("& is not a valid profile", Argx);
|
Error_Pragma_Arg ("& is not a valid profile", Argx);
|
||||||
end if;
|
end if;
|
||||||
|
@ -8481,7 +8550,7 @@ package body Sem_Prag is
|
||||||
GNAT_Pragma;
|
GNAT_Pragma;
|
||||||
Check_Arg_Count (0);
|
Check_Arg_Count (0);
|
||||||
Check_Valid_Configuration_Pragma;
|
Check_Valid_Configuration_Pragma;
|
||||||
Set_Ravenscar (N);
|
Set_Ravenscar_Profile (N);
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
-- Restricted_Run_Time --
|
-- Restricted_Run_Time --
|
||||||
|
@ -9950,6 +10019,7 @@ package body Sem_Prag is
|
||||||
-- Start of prorcessing for Is_Config_Static_String
|
-- Start of prorcessing for Is_Config_Static_String
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
Name_Len := 0;
|
Name_Len := 0;
|
||||||
return Add_Config_Static_String (Arg);
|
return Add_Config_Static_String (Arg);
|
||||||
end Is_Config_Static_String;
|
end Is_Config_Static_String;
|
||||||
|
@ -9965,6 +10035,7 @@ package body Sem_Prag is
|
||||||
-- indicates that appearence in that parameter position is significant.
|
-- indicates that appearence in that parameter position is significant.
|
||||||
|
|
||||||
Sig_Flags : constant array (Pragma_Id) of Int :=
|
Sig_Flags : constant array (Pragma_Id) of Int :=
|
||||||
|
|
||||||
(Pragma_AST_Entry => -1,
|
(Pragma_AST_Entry => -1,
|
||||||
Pragma_Abort_Defer => -1,
|
Pragma_Abort_Defer => -1,
|
||||||
Pragma_Ada_83 => -1,
|
Pragma_Ada_83 => -1,
|
||||||
|
@ -10095,7 +10166,7 @@ package body Sem_Prag is
|
||||||
Pragma_Thread_Body => +2,
|
Pragma_Thread_Body => +2,
|
||||||
Pragma_Time_Slice => -1,
|
Pragma_Time_Slice => -1,
|
||||||
Pragma_Title => -1,
|
Pragma_Title => -1,
|
||||||
Pragma_Unchecked_Union => -1,
|
Pragma_Unchecked_Union => 0,
|
||||||
Pragma_Unimplemented_Unit => -1,
|
Pragma_Unimplemented_Unit => -1,
|
||||||
Pragma_Universal_Data => -1,
|
Pragma_Universal_Data => -1,
|
||||||
Pragma_Unreferenced => -1,
|
Pragma_Unreferenced => -1,
|
||||||
|
|
|
@ -3456,7 +3456,9 @@ package body Sem_Util is
|
||||||
|
|
||||||
-- Done if no more derivations to check
|
-- Done if no more derivations to check
|
||||||
|
|
||||||
elsif T = T1 then
|
elsif T = T1
|
||||||
|
or else T = Etyp
|
||||||
|
then
|
||||||
return False;
|
return False;
|
||||||
|
|
||||||
-- Following test catches error cases resulting from prev errors
|
-- Following test catches error cases resulting from prev errors
|
||||||
|
@ -3471,11 +3473,7 @@ package body Sem_Util is
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Return if no further entries to check
|
T := Base_Type (Etyp);
|
||||||
|
|
||||||
if T = Base_Type (T1) or else T = T1 then
|
|
||||||
return False;
|
|
||||||
end if;
|
|
||||||
end loop;
|
end loop;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -3927,7 +3925,9 @@ package body Sem_Util is
|
||||||
return Attribute_Name (N) = Name_Input;
|
return Attribute_Name (N) = Name_Input;
|
||||||
|
|
||||||
when N_Selected_Component =>
|
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 =>
|
when N_Explicit_Dereference =>
|
||||||
return True;
|
return True;
|
||||||
|
|
|
@ -4246,6 +4246,8 @@ package VMS_Data is
|
||||||
-- UPPER_CASE
|
-- UPPER_CASE
|
||||||
|
|
||||||
S_Pretty_Comments : aliased constant S := "/COMMENTS_LAYOUT=" &
|
S_Pretty_Comments : aliased constant S := "/COMMENTS_LAYOUT=" &
|
||||||
|
"UNTOUCHED " &
|
||||||
|
"-c0 " &
|
||||||
"DEFAULT " &
|
"DEFAULT " &
|
||||||
"-c1 " &
|
"-c1 " &
|
||||||
"STANDARD_INDENT " &
|
"STANDARD_INDENT " &
|
||||||
|
@ -4256,17 +4258,20 @@ package VMS_Data is
|
||||||
"-c4";
|
"-c4";
|
||||||
-- /COMMENTS_LAYOUT[=layout-option, layout-option, ...]
|
-- /COMMENTS_LAYOUT[=layout-option, layout-option, ...]
|
||||||
--
|
--
|
||||||
-- Set the comment layout. By default, comments use the GNAT style comment
|
-- Set the comment layout. By default, comments use the GNAT style
|
||||||
-- line indentation.
|
-- comment line indentation.
|
||||||
-- layout-option may be one of the following:
|
|
||||||
--
|
--
|
||||||
|
-- layout-option is be one of the following:
|
||||||
|
--
|
||||||
|
-- UNTOUCHED All the comments remain unchanged
|
||||||
-- DEFAULT (D) GNAT style comment line indentation
|
-- DEFAULT (D) GNAT style comment line indentation
|
||||||
-- STANDARD_INDENT Standard comment line indentation
|
-- STANDARD_INDENT Standard comment line indentation
|
||||||
-- GNAT_BEGINNING GNAT style comment beginning
|
-- GNAT_BEGINNING GNAT style comment beginning
|
||||||
-- REFORMAT Reformat comment blocks
|
-- REFORMAT Reformat comment blocks
|
||||||
--
|
--
|
||||||
-- All combinations of layout options are allowed, except for DEFAULT
|
-- 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
|
-- The difference between "GNAT style comment line indentation" and
|
||||||
-- "standard comment line indentation" is the following: for standard
|
-- "standard comment line indentation" is the following: for standard
|
||||||
|
@ -4492,6 +4497,13 @@ package VMS_Data is
|
||||||
--
|
--
|
||||||
-- MIXED_CASE Names are in mixed case.
|
-- 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 " &
|
S_Pretty_No_Labels : aliased constant S := "/NO_MISSED_LABELS " &
|
||||||
"-e";
|
"-e";
|
||||||
-- /NO_MISSED_LABELS
|
-- /NO_MISSED_LABELS
|
||||||
|
@ -4533,7 +4545,8 @@ package VMS_Data is
|
||||||
"LOWER_CASE " &
|
"LOWER_CASE " &
|
||||||
"-pL " &
|
"-pL " &
|
||||||
"UPPER_CASE " &
|
"UPPER_CASE " &
|
||||||
-- /PRAGMA_CASING[=pragma-option]
|
"-pU";
|
||||||
|
-- /PRAGMA_CASING[=pragma-option]
|
||||||
--
|
--
|
||||||
-- Set the case of pragma identifiers. The default is Mixed case.
|
-- Set the case of pragma identifiers. The default is Mixed case.
|
||||||
-- pragma-option may be one of the following:
|
-- pragma-option may be one of the following:
|
||||||
|
@ -4541,9 +4554,9 @@ package VMS_Data is
|
||||||
-- MIXED_CASE (D)
|
-- MIXED_CASE (D)
|
||||||
-- LOWER_CASE
|
-- LOWER_CASE
|
||||||
-- UPPER_CASE
|
-- UPPER_CASE
|
||||||
"-pU";
|
|
||||||
S_Pretty_Project : aliased constant S := "/PROJECT_FILE=<" &
|
S_Pretty_Project : aliased constant S := "/PROJECT_FILE=<" &
|
||||||
"-P>";
|
"-P>";
|
||||||
-- /PROJECT_FILE=filename
|
-- /PROJECT_FILE=filename
|
||||||
--
|
--
|
||||||
-- Specifies the main project file to be used. The project files rooted
|
-- 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_Maxind 'Access,
|
||||||
S_Pretty_Mess 'Access,
|
S_Pretty_Mess 'Access,
|
||||||
S_Pretty_Names 'Access,
|
S_Pretty_Names 'Access,
|
||||||
|
S_Pretty_No_Backup 'Access,
|
||||||
S_Pretty_No_Labels 'Access,
|
S_Pretty_No_Labels 'Access,
|
||||||
S_Pretty_Notabs 'Access,
|
S_Pretty_Notabs 'Access,
|
||||||
S_Pretty_Output 'Access,
|
S_Pretty_Output 'Access,
|
||||||
|
|
Loading…
Reference in New Issue