[multiple changes]

2003-11-24  Jose Ruiz  <ruiz@act-europe.fr>

	* Makefile.in:
	Use 5zintman.ads for VxWorks targets. This file avoid confusion between
	signals and interrupts.

	* 5zintman.ads: New File.

	* 5zintman.adb: Replace Exception_Interrupts by Exception_Signals, and
	add exception signals to the set of unmasked signals.

	* 5ztaprop.adb:
	Use Abort_Task_Signal instead of Abort_Task_Interrupt to avoid confusion
	between signals and interrupts.
	Add to Unblocked_Signal_Mask the set of signals that are in
	Keep_Unmasked.

	* 7sinmaop.adb:
	Adding a check to see whether the Interrupt_ID we want to unmask is in
	the range of Keep_Unmasked (in procedure Interrupt_Self_Process). The
	reason is that the index type of the Keep_Unmasked array is not always
	Interrupt_ID; it may be a subtype of Interrupt_ID.

2003-11-24  Gary Dismukes  <dismukes@gnat.com>

	* exp_util.adb:
	(Remove_Side_Effects): Condition constantness of object created for a
	 an unchecked type conversion on the constantness of the expression
	 to ensure the correct value for 'Constrained when passing components
	 of view-converted class-wide objects.

2003-11-24  Robert Dewar  <dewar@gnat.com>

	* par-load.adb (Load): Improve handling of misspelled and missing units
	Removes several cases of compilation abandoned messages

	* lib.adb: (Remove_Unit): New procedure

	* lib.ads: (Remove_Unit): New procedure

	* lib-load.adb: Minor reformatting

2003-11-24  Vincent Celier  <celier@gnat.com>

	* make.adb:
	(Gnatmake, Initialize): Call Usage instead of Makeusg directly
	(Marking_Label): Label to mark processed source files. Incremented for
	each executable.
	(Gnatmake): Increase Marking_Labet for each executable
	(Is_Marked): Compare against marking label
	(Mark): Mark with marking label

2003-11-24  Jerome Guitton  <guitton@act-europe.fr>

	* s-thread.ads:
	Move the declaration of the TSD for System.Threads to System.Soft_Links.
	Add some comments.

	* Makefile.in: Added target pair for s-thread.adb for cert runtime.
	(rts-cert): build a single relocatable object for the run-time lib.
	Fix perms.

2003-11-24  Vasiliy Fofanov  <fofanov@act-europe.fr>

	* Make-lang.in:
	Use gnatls rather than gcc to obtain the location of GNAT RTL for
	crosstools build.

2003-11-24  Sergey Rybin  <rybin@act-europe.fr>

	* opt.adb (Tree_Write): Gnat_Version_String is now a function, so we
	can not use it as before (that is, as a variable) when dumping it into
	the tree file. Add a local variable to store the result of this
	function and to be used as the string to be written into the tree.

	* scn.adb (Initialize_Scanner): Add comments explaining the recent
	changes.

	* sinput.adb (Source_First, Source_Last): In case of
	Internal_Source_File, replace returning attributes of
	Internal_Source_Ptr (which is wrong) with returning attributes of
	Internal_Source.

2003-11-24  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch3.adb:
	(New_Concatenation_Op): Proper name for New_Binary_Operator, only
	used for implicit concatenation operators.
	Code cleanup.

	* sem_elab.adb:
	(Check_Elab_Call): Set No_Elaboration_Check appropriately on calls in
	task bodies that are in the scope of a Suppress pragma.
	(Check_A Call): Use the flag to prevent spurious elaboration checks.

	* sinfo.ads, sinfo.adb:
	New flag No_Elaboration_Check on function/procedure calls, to properly
	suppress checks on calls in task bodies that are within a local suppress
	pragma.

	* exp_ch4.adb:
	(Expand_Concatenate_Other): Use the proper integer type for the
	expression for the upper bound, to avoid universal_integer computations
	when possible.

From-SVN: r73874

gcc/ada/5zintman.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -62,22 +62,27 @@ package body System.Interrupt_Management is
    use System.OS_Interface;
    use type Interfaces.C.int;
 
-   type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
-   Exception_Interrupts : constant Interrupt_List (1 .. 4) :=
+   type Signal_List is array (Signal_ID range <>) of Signal_ID;
+   Exception_Signals : constant Signal_List (1 .. 4) :=
                          (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
 
-   --  Keep these variables global so that they are initialized only once.
+   --  Keep these variables global so that they are initialized only once
+   --  What are "these variables" ???, I see only one
 
    Exception_Action : aliased struct_sigaction;
 
-   ----------------------
-   -- Notify_Exception --
-   ----------------------
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
 
    procedure Notify_Exception (signo : Signal);
    --  Identify the Ada exception to be raised using
    --  the information when the system received a synchronous signal.
 
+   ----------------------
+   -- Notify_Exception --
+   ----------------------
+
    procedure Notify_Exception (signo : Signal) is
       Mask   : aliased sigset_t;
       Result : int;
@@ -126,10 +131,10 @@ package body System.Interrupt_Management is
       old_act : aliased struct_sigaction;
 
    begin
-      for J in Exception_Interrupts'Range loop
+      for J in Exception_Signals'Range loop
          Result :=
            sigaction
-             (Signal (Exception_Interrupts (J)), Exception_Action'Access,
+             (Signal (Exception_Signals (J)), Exception_Action'Access,
               old_act'Unchecked_Access);
          pragma Assert (Result = 0);
       end loop;
@@ -160,15 +165,15 @@ begin
       --  Change this if you want to use another signal for task abort.
       --  SIGTERM might be a good one.
 
-      Abort_Task_Interrupt := SIGABRT;
+      Abort_Task_Signal := SIGABRT;
 
       Exception_Action.sa_handler := Notify_Exception'Address;
       Exception_Action.sa_flags := SA_ONSTACK;
       Result := sigemptyset (mask'Access);
       pragma Assert (Result = 0);
 
-      for J in Exception_Interrupts'Range loop
-         Result := sigaddset (mask'Access, Signal (Exception_Interrupts (J)));
+      for J in Exception_Signals'Range loop
+         Result := sigaddset (mask'Access, Signal (Exception_Signals (J)));
          pragma Assert (Result = 0);
       end loop;
 
@@ -185,5 +190,15 @@ begin
             Reserve (J) := True;
          end if;
       end loop;
+
+      --  Add exception signals to the set of unmasked signals
+
+      for J in Exception_Signals'Range loop
+         Keep_Unmasked (Exception_Signals (J)) := True;
+      end loop;
+
+      --  The abort signal must also be unmasked
+
+      Keep_Unmasked (Abort_Task_Signal) := True;
    end;
 end System.Interrupt_Management;

gcc/ada/5zintman.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the VxWorks version of this package.
+
+--  This package encapsulates and centralizes information about all
+--  uses of interrupts (or signals), including the target-dependent
+--  mapping of interrupts (or signals) to exceptions.
+
+--  Unlike the original design, System.Interrupt_Management can only
+--  be used for tasking systems.
+
+--  PLEASE DO NOT remove the Elaborate_Body pragma from this package.
+--  Elaboration of this package should happen early, as most other
+--  initializations depend on it. Forcing immediate elaboration of
+--  the body also helps to enforce the design assumption that this
+--  is a second-level package, just one level above System.OS_Interface
+--  with no cross-dependencies.
+
+--  PLEASE DO NOT put any subprogram declarations with arguments of
+--  type Interrupt_ID into the visible part of this package. The type
+--  Interrupt_ID is used to derive the type in Ada.Interrupts, and
+--  adding more operations to that type would be illegal according
+--  to the Ada Reference Manual. This is the reason why the signals
+--  sets are implemeneted using visible arrays rather than functions.
+
+with System.OS_Interface;
+--  used for sigset_t
+
+with Interfaces.C;
+--  used for int
+
+package System.Interrupt_Management is
+
+   pragma Elaborate_Body;
+
+   type Interrupt_Mask is limited private;
+
+   type Interrupt_ID is new Interfaces.C.int
+     range 0 .. System.OS_Interface.Max_Interrupt;
+
+   type Interrupt_Set is array (Interrupt_ID) of Boolean;
+
+   subtype Signal_ID is Interrupt_ID
+     range 0 .. Interfaces.C."-" (System.OS_Interface.NSIG, 1);
+
+   type Signal_Set is array (Signal_ID) of Boolean;
+
+   --  The following objects serve as constants, but are initialized
+   --  in the body to aid portability.  This permits us to use more
+   --  portable names for interrupts, where distinct names may map to
+   --  the same interrupt ID value.
+   --
+   --  For example, suppose SIGRARE is a signal that is not defined on
+   --  all systems, but is always reserved when it is defined. If we
+   --  have the convention that ID zero is not used for any "real"
+   --  signals, and SIGRARE = 0 when SIGRARE is not one of the locally
+   --  supported signals, we can write
+   --     Reserved (SIGRARE) := true;
+   --  and the initialization code will be portable.
+
+   Abort_Task_Signal : Signal_ID;
+   --  The signal that is used to implement task abortion if
+   --  an interrupt is used for that purpose. This is one of the
+   --  reserved signals.
+
+   Keep_Unmasked : Signal_Set := (others => False);
+   --  Keep_Unmasked (I) is true iff the signal I is one that must
+   --  that must be kept unmasked at all times, except (perhaps) for
+   --  short critical sections. This includes signals that are
+   --  mapped to exceptions, but may also include interrupts
+   --  (e.g. timer) that need to be kept unmasked for other
+   --  reasons. Where signal masking is per-task, the signal should be
+   --  unmasked in ALL TASKS.
+
+   Reserve : Interrupt_Set := (others => False);
+   --  Reserve (I) is true iff the interrupt I is one that cannot be
+   --  permitted to be attached to a user handler. The possible reasons
+   --  are many. For example, it may be mapped to an exception used to
+   --  implement task abortion, or used to implement time delays.
+
+   procedure Initialize_Interrupts;
+   --  On systems where there is no signal inheritance between tasks (e.g
+   --  VxWorks, GNU/LinuxThreads), this procedure is used to initialize
+   --  interrupts handling in each task. Otherwise this function should
+   --  only be called by initialize in this package body.
+
+private
+   type Interrupt_Mask is new System.OS_Interface.sigset_t;
+   --  In some implementation Interrupt_Mask can be represented
+   --  as a linked list.
+
+end System.Interrupt_Management;

gcc/ada/5ztaprop.adb

@@ -45,8 +45,8 @@ with System.Tasking.Debug;
 
 with System.Interrupt_Management;
 --  used for Keep_Unmasked
---           Abort_Task_Interrupt
---           Interrupt_ID
+--           Abort_Task_Signal
+--           Signal_ID
 --           Initialize_Interrupts
 
 with System.Soft_Links;
@@ -262,7 +262,7 @@ package body System.Task_Primitives.Operations is
 
       Result :=
         sigaction
-          (Signal (Interrupt_Management.Abort_Task_Interrupt),
+          (Signal (Interrupt_Management.Abort_Task_Signal),
            act'Unchecked_Access,
            old_act'Unchecked_Access);
       pragma Assert (Result = 0);
@@ -1008,7 +1008,7 @@ package body System.Task_Primitives.Operations is
 
    begin
       Result := kill (T.Common.LL.Thread,
-        Signal (Interrupt_Management.Abort_Task_Interrupt));
+        Signal (Interrupt_Management.Abort_Task_Signal));
       pragma Assert (Result = 0);
    end Abort_Task;
 
@@ -1126,6 +1126,13 @@ package body System.Task_Primitives.Operations is
       Result := sigemptyset (Unblocked_Signal_Mask'Access);
       pragma Assert (Result = 0);
 
+      for J in Interrupt_Management.Signal_ID loop
+         if System.Interrupt_Management.Keep_Unmasked (J) then
+            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+            pragma Assert (Result = 0);
+         end if;
+      end loop;
+
       Environment_Task_ID := Environment_Task;
 
       --  Initialize the lock used to synchronize chain of all ATCBs.

gcc/ada/7sinmaop.adb

@@ -325,11 +325,16 @@ begin
         Storage_Elements.To_Address
           (Storage_Elements.Integer_Address (SIG_IGN));
 
-      for I in Interrupt_ID loop
-         if Keep_Unmasked (I) then
-            Result := sigaddset (mask'Access, Signal (I));
+      for J in Interrupt_ID loop
+
+         --  We need to check whether J is in Keep_Unmasked because
+         --  the index type of the Keep_Unmasked array is not always
+         --  Interrupt_ID; it may be a subtype of Interrupt_ID.
+
+         if J in Keep_Unmasked'Range and then Keep_Unmasked (J) then
+            Result := sigaddset (mask'Access, Signal (J));
             pragma Assert (Result = 0);
-            Result := sigdelset (allmask'Access, Signal (I));
+            Result := sigdelset (allmask'Access, Signal (J));
             pragma Assert (Result = 0);
          end if;
       end loop;

gcc/ada/ChangeLog

+2003-11-24  Jose Ruiz  <ruiz@act-europe.fr>
+
+	* Makefile.in: 
+	Use 5zintman.ads for VxWorks targets. This file avoid confusion between
+	signals and interrupts.
+
+	* 5zintman.ads: New File.
+
+	* 5zintman.adb: Replace Exception_Interrupts by Exception_Signals, and
+	add exception signals to the set of unmasked signals.
+
+	* 5ztaprop.adb: 
+	Use Abort_Task_Signal instead of Abort_Task_Interrupt to avoid confusion
+	between signals and interrupts.
+	Add to Unblocked_Signal_Mask the set of signals that are in
+	Keep_Unmasked.
+
+	* 7sinmaop.adb: 
+	Adding a check to see whether the Interrupt_ID we want to unmask is in
+	the range of Keep_Unmasked (in procedure Interrupt_Self_Process). The
+	reason is that the index type of the Keep_Unmasked array is not always
+	Interrupt_ID; it may be a subtype of Interrupt_ID.
+
+2003-11-24  Gary Dismukes  <dismukes@gnat.com>
+
+	* exp_util.adb: 
+	(Remove_Side_Effects): Condition constantness of object created for a
+	 an unchecked type conversion on the constantness of the expression
+	 to ensure the correct value for 'Constrained when passing components
+	 of view-converted class-wide objects.
+
+2003-11-24  Robert Dewar  <dewar@gnat.com>
+
+	* par-load.adb (Load): Improve handling of misspelled and missing units
+	Removes several cases of compilation abandoned messages
+
+	* lib.adb: (Remove_Unit): New procedure
+
+	* lib.ads: (Remove_Unit): New procedure
+
+	* lib-load.adb: Minor reformatting
+
+2003-11-24  Vincent Celier  <celier@gnat.com>
+
+	* make.adb: 
+	(Gnatmake, Initialize): Call Usage instead of Makeusg directly
+	(Marking_Label): Label to mark processed source files. Incremented for
+	each executable.
+	(Gnatmake): Increase Marking_Labet for each executable
+	(Is_Marked): Compare against marking label
+	(Mark): Mark with marking label
+
+2003-11-24  Jerome Guitton  <guitton@act-europe.fr>
+
+	* s-thread.ads: 
+	Move the declaration of the TSD for System.Threads to System.Soft_Links.
+	Add some comments.
+
+	* Makefile.in: Added target pair for s-thread.adb for cert runtime.
+	(rts-cert): build a single relocatable object for the run-time lib.
+	Fix perms.
+
+2003-11-24  Vasiliy Fofanov  <fofanov@act-europe.fr>
+
+	* Make-lang.in: 
+	Use gnatls rather than gcc to obtain the location of GNAT RTL for
+	crosstools build.
+
+2003-11-24  Sergey Rybin  <rybin@act-europe.fr>
+
+	* opt.adb (Tree_Write): Gnat_Version_String is now a function, so we
+	can not use it as before (that is, as a variable) when dumping it into
+	the tree file. Add a local variable to store the result of this
+	function and to be used as the string to be written into the tree.
+
+	* scn.adb (Initialize_Scanner): Add comments explaining the recent
+	changes.
+
+	* sinput.adb (Source_First, Source_Last): In case of
+	Internal_Source_File, replace returning attributes of
+	Internal_Source_Ptr (which is wrong) with returning attributes of
+	Internal_Source.
+
+2003-11-24  Ed Schonberg  <schonberg@gnat.com>
+
+	* sem_ch3.adb: 
+	(New_Concatenation_Op): Proper name for New_Binary_Operator, only
+	used for implicit concatenation operators.
+	Code cleanup.
+
+	* sem_elab.adb: 
+	(Check_Elab_Call): Set No_Elaboration_Check appropriately on calls in
+	task bodies that are in the scope of a Suppress pragma.
+	(Check_A Call): Use the flag to prevent spurious elaboration checks.
+
+	* sinfo.ads, sinfo.adb: 
+	New flag No_Elaboration_Check on function/procedure calls, to properly
+	suppress checks on calls in task bodies that are within a local suppress
+	pragma.
+
+	* exp_ch4.adb: 
+	(Expand_Concatenate_Other): Use the proper integer type for the
+	expression for the upper bound, to avoid universal_integer computations
+	when possible.
+
 2003-11-21  Kelley Cook  <kcook@gcc.gnu.org>
 
 	* .cvsignore: Delete.

gcc/ada/Make-lang.in

@@ -290,10 +290,10 @@ regnattools:
 # use host-gcc host-gnatmake host-gnatbind host-gnatlink
 # put the host RTS dir first in the PATH to hide the default runtime
 # files that are among the sources
-RTS_DIR:=$(dir $(subst \,/,$(shell $(CC) -print-libgcc-file-name)))
+RTS_DIR:=$(strip $(subst \,/,$(shell gnatls -v | grep adalib )))
 cross-gnattools: force
 	$(MAKE)  -C ada $(FLAGS_TO_PASS) $(ADA_FLAGS_TO_PASS)\
-	   ADA_INCLUDES="-I$(RTS_DIR)adainclude -I$(RTS_DIR)adalib" \
+	   ADA_INCLUDES="-I$(RTS_DIR)../adainclude -I$(RTS_DIR)" \
 	   GNATMAKE="gnatmake" \
 	   GNATBIND="gnatbind" \
 	   GNATLINK="gnatlink" \

gcc/ada/Makefile.in

@@ -461,6 +461,7 @@ ifeq ($(strip $(filter-out alpha% dec vx%,$(targ))),)
   a-numaux.ads<4znumaux.ads \
   s-inmaop.adb<7sinmaop.adb \
   s-interr.adb<5zinterr.adb \
+  s-intman.ads<5zintman.ads \
   s-intman.adb<5zintman.adb \
   s-osinte.adb<5zosinte.adb \
   s-osinte.ads<5zosinte.ads \
@@ -487,6 +488,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
   a-numaux.ads<4znumaux.ads \
   s-inmaop.adb<7sinmaop.adb \
   s-interr.adb<5zinterr.adb \
+  s-intman.ads<5zintman.ads \
   s-intman.adb<5zintman.adb \
   s-osinte.adb<5zosinte.adb \
   s-osinte.ads<5zosinte.ads \
@@ -524,6 +526,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
   a-numaux.ads<4znumaux.ads \
   s-inmaop.adb<7sinmaop.adb \
   s-interr.adb<5zinterr.adb \
+  s-intman.ads<5zintman.ads \
   s-intman.adb<5zintman.adb \
   s-osinte.adb<5zosinte.adb \
   s-osinte.ads<5zosinte.ads \
@@ -593,6 +596,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
   s-soflin.ads<2ssoflin.ads \
   s-stalib.adb<1sstalib.adb \
   s-stalib.ads<1sstalib.ads \
+  s-thread.adb<5zthread.adb \
   s-thrini.ads<2sthrini.ads \
   s-thrini.adb<5zthrini.adb \
   s-tiitho.adb<5ztiitho.adb \
@@ -619,6 +623,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
   a-numaux.ads<4znumaux.ads \
   s-inmaop.adb<7sinmaop.adb \
   s-interr.adb<5zinterr.adb \
+  s-intman.ads<5zintman.ads \
   s-intman.adb<5zintman.adb \
   s-osinte.adb<5zosinte.adb \
   s-osinte.ads<5zosinte.ads \
@@ -692,7 +697,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
   s-soflin.ads<2ssoflin.ads \
   s-stalib.adb<1sstalib.adb \
   s-stalib.ads<1sstalib.ads \
-  s-thrini.adb<5zthrini.adb \
+  s-thread.adb<5zthread.adb \
   s-thrini.ads<2sthrini.ads \
   s-thrini.adb<5zthrini.adb \
   s-tiitho.adb<5ytiitho.adb \
@@ -736,6 +741,7 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
   a-numaux.ads<4znumaux.ads \
   s-inmaop.adb<7sinmaop.adb \
   s-interr.adb<5zinterr.adb \
+  s-intman.ads<5zintman.ads \
   s-intman.adb<5zintman.adb \
   s-osinte.adb<5zosinte.adb \
   s-osinte.ads<5zosinte.ads \
@@ -764,6 +770,7 @@ ifeq ($(strip $(filter-out xscale% coff wrs vx%,$(targ))),)
   a-numaux.ads<4znumaux.ads \
   s-inmaop.adb<7sinmaop.adb \
   s-interr.adb<5zinterr.adb \
+  s-intman.ads<5zintman.ads \
   s-intman.adb<5zintman.adb \
   s-osinte.adb<5zosinte.adb \
   s-osinte.ads<5zosinte.ads \
@@ -792,6 +799,7 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
   a-numaux.ads<4znumaux.ads \
   s-inmaop.adb<7sinmaop.adb \
   s-interr.adb<5zinterr.adb \
+  s-intman.ads<5zintman.ads \
   s-intman.adb<5zintman.adb \
   s-osinte.adb<5zosinte.adb \
   s-osinte.ads<5zosinte.ads \
@@ -2055,8 +2063,10 @@ rts-cert: force
 	../../../$(GCC_FOR_TARGET) -B../../../ $(TARGET_LIBGCC2_CFLAGS) \
 	$(ALL_CFLAGS) $(GNATLIBCFLAGS_FOR_C) -c ../adainclude/$(f).c \
 	-I../adainclude $(INCLUDES_FOR_SUBDIR) -I../../../ ;) \
-	$(AR) $(AR_FLAGS) libgnat$(arext) \
-	   $(addsuffix .o,$(CERT_LEVEL_B_C_FILES))
+	../../../xgcc -B../../../ *.o -o libgnat ; \
+	$(CHMOD) a-wx *.ali ; \
+	$(RM) *.o ; \
+	$(MV) libgnat libgnat.o
 
 rts-none: force
 	$(MAKE) $(FLAGS_TO_PASS) prepare-rts \

gcc/ada/exp_ch4.adb

@@ -1472,7 +1472,7 @@ package body Exp_Ch4 is
    --  their base type, Ind_Typ their index type, and Arr_Typ the original
    --  array type to which the concatenantion operator applies, then the
    --  following subprogram is constructed:
-   --
+
    --  [function Cnn (S1 : Base_Typ; ...; Sn : Base_Typ) return Base_Typ is
    --      L : Ind_Typ;
    --   begin
@@ -1489,7 +1489,7 @@ package body Exp_Ch4 is
    --      else
    --         return Sn;
    --      end if;
-   --
+
    --      declare
    --         P : Ind_Typ;
    --         H : Ind_Typ :=
@@ -1516,9 +1516,9 @@ package body Exp_Ch4 is
    --               P := Ind_Typ'Succ (P);
    --            end loop;
    --         end if;
-   --
+
    --         ...
-   --
+
    --         if Sn'Length /= 0 then
    --            P := Sn'First;
    --            loop
@@ -1528,7 +1528,7 @@ package body Exp_Ch4 is
    --               P := Ind_Typ'Succ (P);
    --            end loop;
    --         end if;
-   --
+
    --         return R;
    --      end;
    --   end Cnn;]
@@ -1598,7 +1598,9 @@ package body Exp_Ch4 is
       --  Builds reference to identifier L.
 
       function L_Pos return Node_Id;
-      --  Builds expression Ind_Typ'Pos (L).
+      --  Builds expression Integer_Type'(Ind_Typ'Pos (L)).
+      --  We qualify the expression to avoid universal_integer computations
+      --  whenever possible, in the expression for the upper bound H.
 
       function L_Succ return Node_Id;
       --  Builds expression Ind_Typ'Succ (L).
@@ -1743,12 +1745,31 @@ package body Exp_Ch4 is
       -----------
 
       function L_Pos return Node_Id is
+         Target_Type : Entity_Id;
+
       begin
+         --  If the index type is an enumeration type, the computation
+         --  can be done in standard integer. Otherwise, choose a large
+         --  enough integer type.
+
+         if Is_Enumeration_Type (Ind_Typ)
+           or else Root_Type (Ind_Typ) = Standard_Integer
+           or else Root_Type (Ind_Typ) = Standard_Short_Integer
+           or else Root_Type (Ind_Typ) = Standard_Short_Short_Integer
+         then
+            Target_Type := Standard_Integer;
+         else
+            Target_Type := Root_Type (Ind_Typ);
+         end if;
+
          return
+           Make_Qualified_Expression (Loc,
+              Subtype_Mark => New_Reference_To (Target_Type, Loc),
+              Expression   =>
                 Make_Attribute_Reference (Loc,
                   Prefix         => New_Reference_To (Ind_Typ, Loc),
                   Attribute_Name => Name_Pos,
-             Expressions    => New_List (L));
+                  Expressions    => New_List (L)));
       end L_Pos;
 
       ------------

gcc/ada/exp_util.adb

@@ -3510,7 +3510,7 @@ package body Exp_Util is
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Def_Id,
                 Object_Definition   => New_Reference_To (Exp_Type, Loc),
-                Constant_Present    => True,
+                Constant_Present    => not Is_Variable (Exp),
                 Expression          => Relocate_Node (Exp));
 
             Set_Assignment_OK (E);

gcc/ada/lib-load.adb

@@ -688,14 +688,11 @@ package body Lib.Load is
 
    procedure Make_Instance_Unit (N : Node_Id) is
       Sind : constant Source_File_Index := Source_Index (Main_Unit);
-
    begin
       Units.Increment_Last;
-
       Units.Table (Units.Last)               := Units.Table (Main_Unit);
       Units.Table (Units.Last).Cunit         := Library_Unit (N);
       Units.Table (Units.Last).Generate_Code := True;
-
       Units.Table (Main_Unit).Cunit          := N;
       Units.Table (Main_Unit).Unit_Name      :=
         Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
@@ -713,7 +710,6 @@ package body Lib.Load is
    is
       Sunit : constant Node_Id := Cunit (Spec_Unit);
       Bunit : constant Node_Id := Cunit (Body_Unit);
-
    begin
       --  The spec is irrelevant if the body is a subprogram body, and the
       --  spec is other than a subprogram spec or generic subprogram spec.
@@ -725,7 +721,6 @@ package body Lib.Load is
          Nkind (Unit (Bunit)) = N_Subprogram_Body
            and then Nkind (Unit (Sunit)) /= N_Subprogram_Declaration
            and then Nkind (Unit (Sunit)) /= N_Generic_Subprogram_Declaration;
-
    end Spec_Is_Irrelevant;
 
    --------------------
@@ -735,9 +730,7 @@ package body Lib.Load is
    procedure Version_Update (U : Node_Id; From : Node_Id) is
       Unum  : constant Unit_Number_Type := Get_Cunit_Unit_Number (U);
       Fnum  : constant Unit_Number_Type := Get_Cunit_Unit_Number (From);
-
    begin
-
       if Source_Index (Fnum) /= No_Source_File then
          Units.Table (Unum).Version :=
            Units.Table (Unum).Version

gcc/ada/lib.adb

@@ -870,6 +870,17 @@ package body Lib is
       return Int (Units.Last) - Int (Main_Unit) + 1;
    end Num_Units;
 
+   -----------------
+   -- Remove_Unit --
+   -----------------
+
+   procedure Remove_Unit (U : Unit_Number_Type) is
+   begin
+      if U = Units.Last then
+         Units.Decrement_Last;
+      end if;
+   end Remove_Unit;
+
    ----------------------------------
    -- Replace_Linker_Option_String --
    ----------------------------------

gcc/ada/lib.ads

@@ -417,6 +417,10 @@ package Lib is
    function Num_Units return Nat;
    --  Number of units currently in unit table
 
+   procedure Remove_Unit (U : Unit_Number_Type);
+   --  Remove unit U from unit table. Currently this is effective only
+   --  if U is the last unit currently stored in the unit table.
+
    function Entity_Is_In_Main_Unit (E : Entity_Id) return Boolean;
    --  Returns True if the entity E is declared in the main unit, or, in
    --  its corresponding spec, or one of its subunits. Entities declared

gcc/ada/make.adb

@@ -24,12 +24,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Exceptions;   use Ada.Exceptions;
-with Ada.Command_Line; use Ada.Command_Line;
-
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.Case_Util;            use GNAT.Case_Util;
-
 with ALI;      use ALI;
 with ALI.Util; use ALI.Util;
 with Csets;
@@ -65,6 +59,12 @@ with System.HTable;
 with Targparm;
 with Tempdir;
 
+with Ada.Exceptions;   use Ada.Exceptions;
+with Ada.Command_Line; use Ada.Command_Line;
+
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Case_Util;            use GNAT.Case_Util;
+
 package body Make is
 
    use ASCII;
@@ -480,6 +480,9 @@ package body Make is
    -- Marking Routines --
    ----------------------
 
+   Marking_Label : Byte := 1;
+   --  Value to mark the source files
+
    procedure Mark (Source_File : File_Name_Type);
    --  Mark Source_File. Marking is used to signal that Source_File has
    --  already been inserted in the Q.
@@ -2233,7 +2236,9 @@ package body Make is
       -------------
 
       function Compile
-        (S : Name_Id; L : Name_Id; Args : Argument_List) return Process_Id
+        (S    : Name_Id;
+         L    : Name_Id;
+         Args : Argument_List) return Process_Id
       is
          Comp_Args : Argument_List (Args'First .. Args'Last + 8);
          Comp_Next : Integer := Args'First;
@@ -3692,7 +3697,7 @@ package body Make is
          else
             --  Output usage information if no files to compile
 
-            Makeusg;
+            Usage;
             Exit_Program (E_Fatal);
          end if;
       end if;
@@ -4228,6 +4233,18 @@ package body Make is
 
       Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
 
+         --  Increase the marking label to be sure to check sources
+         --  for all executables.
+
+         Marking_Label := Marking_Label + 1;
+
+         --  Make sure it is not 0, which is the default value for
+         --  a file that has never been marked.
+
+         if Marking_Label = 0 then
+            Marking_Label := 1;
+         end if;
+
          --  First, find the executable name and path
 
          Executable          := No_File;
@@ -5573,7 +5590,7 @@ package body Make is
       end loop Scan_Args;
 
       if Usage_Requested then
-         Makeusg;
+         Usage;
       end if;
 
       --  Test for trailing -P switch
@@ -5695,6 +5712,10 @@ package body Make is
                Make_Failed (Exception_Message (Err));
          end;
       end if;
+
+      --  Set the marking label to a value that is not zero
+
+      Marking_Label := 1;
    end Initialize;
 
    -----------------------------------
@@ -5709,6 +5730,7 @@ package body Make is
       Put_In_Q : Boolean := Into_Q;
       Unit     : Com.Unit_Data;
       Sfile    : Name_Id;
+
       Extending : constant Boolean :=
                     Projects.Table (The_Project).Extends /= No_Project;
 
@@ -6044,7 +6066,7 @@ package body Make is
 
    function Is_Marked (Source_File : File_Name_Type) return Boolean is
    begin
-      return Get_Name_Table_Byte (Source_File) /= 0;
+      return Get_Name_Table_Byte (Source_File) = Marking_Label;
    end Is_Marked;
 
    ----------
@@ -6228,7 +6250,7 @@ package body Make is
 
    procedure Mark (Source_File : File_Name_Type) is
    begin
-      Set_Name_Table_Byte (Source_File, 1);
+      Set_Name_Table_Byte (Source_File, Marking_Label);
    end Mark;
 
    --------------------

gcc/ada/opt.adb

@@ -186,6 +186,7 @@ package body Opt is
    ----------------
 
    procedure Tree_Write is
+      Version_String : String := Gnat_Version_String;
    begin
       Tree_Write_Int  (ASIS_Version_Number);
       Tree_Write_Bool (Brief_Output);
@@ -202,9 +203,9 @@ package body Opt is
       Tree_Write_Bool (Assertions_Enabled);
       Tree_Write_Bool (Enable_Overflow_Checks);
       Tree_Write_Bool (Full_List);
-      Tree_Write_Int  (Int (Gnat_Version_String'Length));
-      Tree_Write_Data (Gnat_Version_String'Address,
-                       Gnat_Version_String'Length);
+      Tree_Write_Int  (Int (Version_String'Length));
+      Tree_Write_Data (Version_String'Address,
+                       Version_String'Length);
       Tree_Write_Data (Distribution_Stub_Mode'Address,
                        Distribution_Stub_Mode_Type'Object_Size / Storage_Unit);
       Tree_Write_Bool (Immediate_Errors);

gcc/ada/par-load.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 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- --
@@ -42,6 +42,8 @@ with Sinput.L; use Sinput.L;
 with Stylesw;  use Stylesw;
 with Validsw;  use Validsw;
 
+with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
+
 separate (Par)
 procedure Load is
 
@@ -188,26 +190,45 @@ begin
                     or else
                   Name_Buffer (1) = 'g')
       then
-         --  In the predefined file case, we know the user did not construct
-         --  their own package, but we got the wrong one. This means that the
-         --  name supplied by the user crunched to something we recognized,
-         --  but then the file did not contain the unit expected. Most likely
-         --  this is due to a misspelling, e.g.
+         declare
+            Expect_Name : constant Name_Id := Expected_Unit (Cur_Unum);
+            Actual_Name : constant Name_Id := Unit_Name (Cur_Unum);
+
+         begin
+            Error_Msg_Name_1 := Expect_Name;
+            Error_Msg ("% is not a predefined library unit!", Loc);
+
+            --  In the predefined file case, we know the user did not
+            --  construct their own package, but we got the wrong one.
+            --  This means that the name supplied by the user crunched
+            --  to something we recognized, but then the file did not
+            --  contain the unit expected. Most likely this is due to
+            --  a misspelling, e.g.
 
             --    with Ada.Calender;
 
             --  This crunches to a-calend, which indeed contains the unit
-         --  Ada.Calendar, and we can diagnose the misspelling. This is
-         --  a simple heuristic, but it catches many common cases of
-         --  misspelling of predefined unit names without needing a full
-         --  list of them.
+            --  Ada.Calendar, and we can diagnose the misspelling. This
+            --  is a simple heuristic, but it catches many common cases
+            --  of misspelling of predefined unit names without needing
+            --  a full list of them.
 
-         Error_Msg_Name_1 := Expected_Unit (Cur_Unum);
-         Error_Msg ("% is not a predefined library unit!", Loc);
-         Error_Msg_Name_1 := Unit_Name (Cur_Unum);
+            --  Before actually issinying the message, we will check that the
+            --  unit name is indeed a plausible misspelling of the one we got.
+
+            if Is_Bad_Spelling_Of
+              (Found  => Get_Name_String (Expect_Name),
+               Expect => Get_Name_String (Actual_Name))
+            then
+               Error_Msg_Name_1 := Actual_Name;
                Error_Msg ("possible misspelling of %!", Loc);
+            end if;
+         end;
 
-      --  Non-predefined file name case
+      --  Non-predefined file name case. In this case we generate a message
+      --  and then we quit, because we are in big trouble, and if we try
+      --  to continue compilation, we get into some nasty situations
+      --  (for example in some subunit cases).
 
       else
          Error_Msg ("file { does not contain expected unit!", Loc);
@@ -217,7 +238,10 @@ begin
          Error_Msg ("found unit $!", Loc);
       end if;
 
-      raise Unrecoverable_Error;
+      --  In both cases, remove the unit if it is the last unit (which it
+      --  normally (always?) will be) so that it is out of the way later.
+
+      Remove_Unit (Cur_Unum);
    end if;
 
    --  If current unit is a body, load its corresponding spec

gcc/ada/s-thread.ads

@@ -38,6 +38,10 @@
 --  VxWorks AE653 with the restricted / cert runtime
 
 with Ada.Exceptions;
+--  used for Exception_Occurrence
+
+with System.Soft_Links;
+--  used for TSD
 
 package System.Threads is
 
@@ -137,27 +141,6 @@ package System.Threads is
 
 private
 
-   ------------------------
-   -- Task Specific Data --
-   ------------------------
-
-   type ATSD is limited record
-      Jmpbuf_Address : Address := Null_Address;
-      --  Address of jump buffer used to store the address of the
-      --  current longjmp/setjmp buffer for exception management.
-      --  These buffers are threaded into a stack, and the address
-      --  here is the top of the stack. A null address means that
-      --  no exception handler is currently active.
-
-      Sec_Stack_Addr : Address := Null_Address;
-      --  Address of currently allocated secondary stack
-
-      Current_Excep : aliased EO;
-      --  Exception occurrence that contains the information for the
-      --  current exception. Note that any exception in the same task
-      --  destroys this information, so the data in this variable must
-      --  be copied out before another exception can occur.
-
-   end record;
+   type ATSD is new System.Soft_Links.TSD;
 
 end System.Threads;

gcc/ada/scn.adb

@@ -261,7 +261,9 @@ package body Scn is
    begin
       Scanner.Initialize_Scanner (Unit, Index);
 
-      --  Set default for Comes_From_Source. All nodes built now until we
+      --  Set default for Comes_From_Source (except if we are going to process
+      --  an artificial string internally created within the compiler and
+      --  placed into internal source duffer). All nodes built now until we
       --  reenter the analyzer will have Comes_From_Source set to True
 
       if Index /= Internal_Source_File then
@@ -280,6 +282,16 @@ package body Scn is
       --  call Scan. Scan initial token (note this initializes Prev_Token,
       --  Prev_Token_Ptr).
 
+      --  There are two reasons not to do the Scan step in case if we
+      --  initialize the scanner for the internal source buffer:
+
+      --  - The artificial string may not be created by the compiler in this
+      --    buffer when we call Initialize_Scanner
+
+      --  - For these artificial strings a special way of scanning is used, so
+      --    the standard step of the scanner may just break the algorithm of
+      --    processing these strings.
+
       if Index /= Internal_Source_File then
          Scan;
       end if;

gcc/ada/sem_ch3.adb

@@ -548,9 +548,9 @@ package body Sem_Ch3 is
    --  Create new modular type. Verify that modulus is in  bounds and is
    --  a power of two (implementation restriction).
 
-   procedure New_Binary_Operator (Op_Name : Name_Id; Typ : Entity_Id);
+   procedure New_Concatenation_Op (Typ : Entity_Id);
    --  Create an abbreviated declaration for an operator in order to
-   --  materialize minimally operators on derived types.
+   --  materialize concatenation on array types.
 
    procedure Ordinary_Fixed_Point_Type_Declaration
      (T   : Entity_Id;
@@ -2865,7 +2865,7 @@ package body Sem_Ch3 is
       if Number_Dimensions (T) = 1
          and then not Is_Packed_Array_Type (T)
       then
-         New_Binary_Operator (Name_Op_Concat, T);
+         New_Concatenation_Op (T);
       end if;
 
       --  In the case of an unconstrained array the parser has already
@@ -3068,7 +3068,7 @@ package body Sem_Ch3 is
         and then not Is_Derived_Type (Parent_Type)
         and then not Is_Package (Scope (Base_Type (Parent_Type)))
       then
-         New_Binary_Operator (Name_Op_Concat, Derived_Type);
+         New_Concatenation_Op (Derived_Type);
       end if;
    end Build_Derived_Array_Type;
 
@@ -10945,11 +10945,11 @@ package body Sem_Ch3 is
 
    end Modular_Type_Declaration;
 
-   -------------------------
-   -- New_Binary_Operator --
-   -------------------------
+   --------------------------
+   -- New_Concatenation_Op --
+   --------------------------
 
-   procedure New_Binary_Operator (Op_Name : Name_Id; Typ : Entity_Id) is
+   procedure New_Concatenation_Op (Typ : Entity_Id) is
       Loc : constant Source_Ptr := Sloc (Typ);
       Op  : Entity_Id;
 
@@ -10971,26 +10971,26 @@ package body Sem_Ch3 is
          return Formal;
       end Make_Op_Formal;
 
-   --  Start of processing for New_Binary_Operator
+   --  Start of processing for New_Concatenation_Op
 
    begin
-      Op := Make_Defining_Operator_Symbol (Loc, Op_Name);
+      Op := Make_Defining_Operator_Symbol (Loc, Name_Op_Concat);
 
       Set_Ekind                   (Op, E_Operator);
       Set_Scope                   (Op, Current_Scope);
       Set_Etype                   (Op, Typ);
-      Set_Homonym                 (Op, Get_Name_Entity_Id (Op_Name));
+      Set_Homonym                 (Op, Get_Name_Entity_Id (Name_Op_Concat));
       Set_Is_Immediately_Visible  (Op);
       Set_Is_Intrinsic_Subprogram (Op);
       Set_Has_Completion          (Op);
       Append_Entity               (Op, Current_Scope);
 
-      Set_Name_Entity_Id (Op_Name, Op);
+      Set_Name_Entity_Id (Name_Op_Concat, Op);
 
       Append_Entity (Make_Op_Formal (Typ, Op), Op);
       Append_Entity (Make_Op_Formal (Typ, Op), Op);
 
-   end New_Binary_Operator;
+   end New_Concatenation_Op;
 
    -------------------------------------------
    -- Ordinary_Fixed_Point_Type_Declaration --

gcc/ada/sem_elab.adb

@@ -325,6 +325,16 @@ package body Sem_Elab is
       --  we ignore this flag.
 
    begin
+      --  If the call is known to be within a local Suppress Elaboration
+      --  pragma, nothing to check. This can happen in task bodies.
+
+      if (Nkind (N) = N_Function_Call
+           or else Nkind (N) = N_Procedure_Call_Statement)
+        and then  No_Elaboration_Check (N)
+      then
+         return;
+      end if;
+
       --  Go to parent for derived subprogram, or to original subprogram
       --  in the case of a renaming (Alias covers both these cases)
 
@@ -826,10 +836,41 @@ package body Sem_Elab is
      (N           : Node_Id;
       Outer_Scope : Entity_Id := Empty)
    is
-      Nam : Node_Id;
       Ent : Entity_Id;
       P   : Node_Id;
 
+      function Get_Called_Ent return Entity_Id;
+      --  Retrieve called entity. If this is a call to a protected subprogram,
+      --  entity is a selected component. The callable entity may be absent,
+      --  in which case there is no check to perform.  This happens with
+      --  non-analyzed calls in nested generics.
+
+      --------------------
+      -- Get_Called_Ent --
+      --------------------
+
+      function Get_Called_Ent return Entity_Id is
+         Nam : Node_Id;
+
+      begin
+         Nam := Name (N);
+
+         if No (Nam) then
+            return Empty;
+
+         elsif Nkind (Nam) = N_Selected_Component then
+            return Entity (Selector_Name (Nam));
+
+         elsif not Is_Entity_Name (Nam) then
+            return Empty;
+
+         else
+            return Entity (Nam);
+         end if;
+      end Get_Called_Ent;
+
+   --  Start of processing for Check_Elab_Call
+
    begin
       --  For an entry call, check relevant restriction
 
@@ -1014,6 +1055,26 @@ package body Sem_Elab is
 
                         exit;
 
+                     elsif Nkind (P) = N_Task_Body then
+
+                        --  The check is deferred until Check_Task_Activation
+                        --  but we need to capture local suppress pragmas
+                        --  that may inhibit checks on this call.
+
+                        Ent := Get_Called_Ent;
+
+                        if No (Ent) then
+                           return;
+
+                        elsif Elaboration_Checks_Suppressed (Current_Scope)
+                          or else Elaboration_Checks_Suppressed (Ent)
+                          or else Elaboration_Checks_Suppressed (Scope (Ent))
+                        then
+                           Set_No_Elaboration_Check (N);
+                        end if;
+
+                        return;
+
                      --  Static model, call is not in elaboration code, we
                      --  never need to worry, because in the static model
                      --  the top level caller always takes care of things.
@@ -1027,25 +1088,7 @@ package body Sem_Elab is
          end if;
       end if;
 
-      --  Retrieve called entity. If this is a call to a protected subprogram,
-      --  the entity is a selected component.
-      --  The callable entity may be absent, in which case there is nothing
-      --  to do. This happens with non-analyzed calls in nested generics.
-
-      Nam := Name (N);
-
-      if No (Nam) then
-         return;
-
-      elsif Nkind (Nam) = N_Selected_Component then
-         Ent := Entity (Selector_Name (Nam));
-
-      elsif not Is_Entity_Name (Nam) then
-         return;
-
-      else
-         Ent := Entity (Nam);
-      end if;
+      Ent := Get_Called_Ent;
 
       if No (Ent) then
          return;

gcc/ada/sinfo.adb

@@ -1764,6 +1764,15 @@ package body Sinfo is
       return Flag7 (N);
    end No_Ctrl_Actions;
 
+   function No_Elaboration_Check
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Function_Call
+        or else NT (N).Nkind = N_Procedure_Call_Statement);
+      return Flag14 (N);
+   end No_Elaboration_Check;
+
    function No_Entities_Ref_In_Spec
       (N : Node_Id) return Boolean is
    begin
@@ -4187,6 +4196,15 @@ package body Sinfo is
       Set_Flag7 (N, Val);
    end Set_No_Ctrl_Actions;
 
+   procedure Set_No_Elaboration_Check
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Function_Call
+        or else NT (N).Nkind = N_Procedure_Call_Statement);
+      Set_Flag14 (N, Val);
+   end Set_No_Elaboration_Check;
+
    procedure Set_No_Entities_Ref_In_Spec
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -1266,6 +1266,13 @@ package Sinfo is
    --    where the generated assignments are more initialisations than real
    --    assignments.
 
+   --  No_Elaboration_Check (Flag14-Sem)
+   --    Present in N_Function_Call and N_Procedure_Call_Statement. Indicates
+   --    that no elaboration check is needed on the call, because it appears
+   --    in the context of a local Suppress pragma. This is used on calls
+   --    within task bodies, where the actual elaboration checks are applied
+   --    after analysis, when the local scope stack is not present.
+
    --  No_Entities_Ref_In_Spec (Flag8-Sem)
    --    Present in N_With_Clause nodes. Set if the with clause is on the
    --    package or subprogram spec where the main unit is the corresponding
@@ -4043,6 +4050,7 @@ package Sinfo is
       --  First_Named_Actual (Node4-Sem)
       --  Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
       --  Do_Tag_Check (Flag13-Sem)
+      --  No_Elaboration_Check (Flag14-Sem)
       --  Parameter_List_Truncated (Flag17-Sem)
       --  ABE_Is_Certain (Flag18-Sem)
       --  plus fields for expression
@@ -4073,6 +4081,7 @@ package Sinfo is
       --  First_Named_Actual (Node4-Sem)
       --  Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
       --  Do_Tag_Check (Flag13-Sem)
+      --  No_Elaboration_Check (Flag14-Sem)
       --  Parameter_List_Truncated (Flag17-Sem)
       --  ABE_Is_Certain (Flag18-Sem)
       --  plus fields for expression
@@ -7391,6 +7400,9 @@ package Sinfo is
    function No_Ctrl_Actions
      (N : Node_Id) return Boolean;    -- Flag7
 
+   function No_Elaboration_Check
+     (N : Node_Id) return Boolean;    -- Flag14
+
    function No_Entities_Ref_In_Spec
      (N : Node_Id) return Boolean;    -- Flag8
 
@@ -8165,6 +8177,9 @@ package Sinfo is
    procedure Set_No_Ctrl_Actions
      (N : Node_Id; Val : Boolean := True);    -- Flag7
 
+   procedure Set_No_Elaboration_Check
+     (N : Node_Id; Val : Boolean := True);    -- Flag14
+
    procedure Set_No_Entities_Ref_In_Spec
      (N : Node_Id; Val : Boolean := True);    -- Flag8
 
@@ -8600,6 +8615,7 @@ package Sinfo is
    pragma Inline (Next_Rep_Item);
    pragma Inline (Next_Use_Clause);
    pragma Inline (No_Ctrl_Actions);
+   pragma Inline (No_Elaboration_Check);
    pragma Inline (No_Entities_Ref_In_Spec);
    pragma Inline (No_Initialization);
    pragma Inline (No_Truncation);
@@ -8854,6 +8870,7 @@ package Sinfo is
    pragma Inline (Set_Next_Named_Actual);
    pragma Inline (Set_Next_Use_Clause);
    pragma Inline (Set_No_Ctrl_Actions);
+   pragma Inline (Set_No_Elaboration_Check);
    pragma Inline (Set_No_Entities_Ref_In_Spec);
    pragma Inline (Set_No_Initialization);
    pragma Inline (Set_No_Truncation);

gcc/ada/sinput.adb

@@ -1111,7 +1111,7 @@ package body Sinput is
    function Source_First (S : SFI) return Source_Ptr is
    begin
       if S = Internal_Source_File then
-         return Internal_Source_Ptr'First;
+         return Internal_Source'First;
       else
          return Source_File.Table (S).Source_First;
       end if;
@@ -1120,7 +1120,7 @@ package body Sinput is
    function Source_Last (S : SFI) return Source_Ptr is
    begin
       if S = Internal_Source_File then
-         return Internal_Source_Ptr'Last;
+         return Internal_Source'Last;
       else
          return Source_File.Table (S).Source_Last;
       end if;