diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-27 13:09:26 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-27 13:09:26 +0000 |
commit | 9756a6054895622617170db2d3680bb2e753b187 (patch) | |
tree | 117c6dde30102543581aa4da898f72f25fea3aa8 | |
parent | d9e964624725bb02949954e1beb3559930cbecd8 (diff) | |
download | gcc-9756a6054895622617170db2d3680bb2e753b187.tar.gz |
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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@82324 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/ada/ChangeLog | 98 | ||||
-rw-r--r-- | gcc/ada/Makefile.in | 1 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 4 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 23 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 19 | ||||
-rw-r--r-- | gcc/ada/gnat_rm.texi | 284 | ||||
-rw-r--r-- | gcc/ada/gnat_ugn.texi | 13 | ||||
-rw-r--r-- | gcc/ada/lang-specs.h | 5 | ||||
-rw-r--r-- | gcc/ada/lib-xref.adb | 21 | ||||
-rw-r--r-- | gcc/ada/rtsfind.adb | 8 | ||||
-rw-r--r-- | gcc/ada/rtsfind.ads | 14 | ||||
-rw-r--r-- | gcc/ada/s-interr.adb | 151 | ||||
-rw-r--r-- | gcc/ada/sem.ads | 26 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 84 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 20 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 87 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 14 | ||||
-rw-r--r-- | gcc/ada/symbols-vms-alpha.adb (renamed from gcc/ada/symbols-vms.adb) | 0 | ||||
-rw-r--r-- | gcc/ada/vms_data.ads | 30 |
19 files changed, 633 insertions, 269 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a3d34f66dc4..f829316f405 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index 79d404516e7..bf691bb3aa2 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -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 \ diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 3b5c5bc033b..47685f64639 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4ae959a992d..8703e27b27b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c9d59c22d49..b049710f922 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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 diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 614064ff313..17daf356721 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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 diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index c75882bc78c..300e9602128 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -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 diff --git a/gcc/ada/lang-specs.h b/gcc/ada/lang-specs.h index 8cd85a81c60..1de5f4e134e 100644 --- a/gcc/ada/lang-specs.h +++ b/gcc/ada/lang-specs.h @@ -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}, diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 107c84951c2..1f271e89c21 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -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 diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index b43da3db603..720ad257a83 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -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; -------------------- diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 1f8bcab95da..0ec821cceba 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -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, diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 39860017d7b..5210c9eee7a 100644 --- a/gcc/ada/s-interr.adb +++ b/gcc/ada/s-interr.adb @@ -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. + null; - POP.Unlock (Self_ID); + else + -- 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 Single_Lock then - POP.Unlock_RTS; - end if; + -- If there is no calls to make we need to regenerate the + -- Interrupt in order not to lose it. - Tmp_Handler.all; + if User_Handler (Interrupt).H /= null then + Tmp_Handler := User_Handler (Interrupt).H; - if Single_Lock then - POP.Lock_RTS; - end if; + -- RTS calls should not be made with self being locked. - POP.Write_Lock (Self_ID); + POP.Unlock (Self_ID); - elsif User_Entry (Interrupt).T /= Null_Task then - Tmp_ID := User_Entry (Interrupt).T; - Tmp_Entry_Index := User_Entry (Interrupt).E; + if Single_Lock then + POP.Unlock_RTS; + end if; - -- RTS calls should not be made with self being locked. + Tmp_Handler.all; - if Single_Lock then - POP.Unlock_RTS; - end if; + if Single_Lock then + POP.Lock_RTS; + end if; - POP.Unlock (Self_ID); + POP.Write_Lock (Self_ID); - System.Tasking.Rendezvous.Call_Simple - (Tmp_ID, Tmp_Entry_Index, System.Null_Address); + elsif User_Entry (Interrupt).T /= Null_Task then + Tmp_ID := User_Entry (Interrupt).T; + Tmp_Entry_Index := User_Entry (Interrupt).E; - POP.Write_Lock (Self_ID); + -- RTS calls should not be made with self being locked. - if Single_Lock then - POP.Lock_RTS; - end if; + if Single_Lock then + POP.Unlock_RTS; + end if; - 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; + POP.Unlock (Self_ID); + + System.Tasking.Rendezvous.Call_Simple + (Tmp_ID, Tmp_Entry_Index, System.Null_Address); - IMOP.Interrupt_Self_Process (IMNG.Interrupt_ID (Interrupt)); + 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; diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index ccd082debcc..1524cbf97e6 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 7684845103a..6d4e25d2d7f 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 8722b77692d..48169d94f12 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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 @@ -4453,6 +4454,25 @@ package body Sem_Ch4 is 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; end; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d3ee90e982f..a48a6ca0479 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9eb9af0b388..446a834bed5 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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; diff --git a/gcc/ada/symbols-vms.adb b/gcc/ada/symbols-vms-alpha.adb index c623e42b383..c623e42b383 100644 --- a/gcc/ada/symbols-vms.adb +++ b/gcc/ada/symbols-vms-alpha.adb diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index ca621b033b6..df0211d226b 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -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, |