* 3vtrasym.adb:

	Demangle Ada symbols returned by TBK$SYMBOLIZE. Correctly align line
	numbers when symbol name is too long.

	* g-signal.ads, g-signal.adb: New files

	* impunit.adb: (Non_Imp_File_Names): Added "g-signal"

	* Makefile.rtl: Introduce GNAT.Signals

	* freeze.adb: Minor reformatting

	* lib-writ.adb (Write_ALI): Never write ali file if -gnats is specified

	* par.adb, par-ch12.adb, par-ch13.adb, par-ch2.adb, par-ch3.adb,
	par-ch5.adb, par-ch6.adb, par-ch9.adb, par-util.adb:
	New handling of Id_Check parameter to improve recognition of keywords
	used as identifiers.
	Update copyright notice to include 2003


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@73083 138bc75d-0d04-0410-961f-82ee72b054a4

17 files changed, 459 insertions, 66 deletions

diff --git a/gcc/ada/3vtrasym.adb b/gcc/ada/3vtrasym.adb
index d11e26b730c..159c03fe279 100644
--- a/gcc/ada/3vtrasym.adb
+++ b/gcc/ada/3vtrasym.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 1999-2003 Ada Core Technologies, Inc.            --
+--           Copyright (C) 1999-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- --
@@ -26,7 +26,8 @@
 -- however invalidate  any other reasons why  the executable file  might be --
 -- covered by the  GNU Public License.                                      --
 --                                                                          --
--- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -96,12 +97,83 @@ package body GNAT.Traceback.Symbolic is
        Value, Value),
        User_Act_Proc);
 
+   function Demangle_Ada (Mangled : String) return String;
+   --  Demangles an Ada symbol. Removes leading "_ada_" and trailing
+   --  __{DIGIT}+ or ${DIGIT}+, converts other "__" to '.'
+
+
+   ------------------
+   -- Demangle_Ada --
+   ------------------
+
+   function Demangle_Ada (Mangled : String) return String is
+      Demangled : String (1 .. Mangled'Length);
+      Pos  : Integer := Mangled'First;
+      Last : Integer := Mangled'Last;
+      DPos : Integer := 1;
+   begin
+
+      if Pos > Last then
+         return "";
+      end if;
+
+      --  Skip leading _ada_
+
+      if Mangled'Length > 4 and then Mangled (Pos .. Pos + 4) = "_ada_" then
+         Pos := Pos + 5;
+      end if;
+
+      --  Skip trailing __{DIGIT}+ or ${DIGIT}+
+
+      if Mangled (Last) in '0' .. '9' then
+
+         for J in reverse Pos + 2 .. Last - 1 loop
+
+            case Mangled (J) is
+               when '0' .. '9' =>
+                  null;
+               when '$' =>
+                  Last := J - 1;
+                  exit;
+               when '_' =>
+                  if Mangled (J - 1) = '_' then
+                     Last := J - 2;
+                  end if;
+                  exit;
+               when others =>
+                  exit;
+            end case;
+
+         end loop;
+
+      end if;
+
+      --  Now just copy Mangled to Demangled, converting "__" to '.' on the fly
+
+      while Pos <= Last loop
+
+         if Mangled (Pos) = '_' and then Mangled (Pos + 1) = '_'
+           and then Pos /= Mangled'First then
+            Demangled (DPos) := '.';
+            Pos := Pos + 2;
+         else
+            Demangled (DPos) := Mangled (Pos);
+            Pos := Pos + 1;
+         end if;
+
+         DPos := DPos + 1;
+
+      end loop;
+
+      return Demangled (1 .. DPos - 1);
+   end Demangle_Ada;
+
    ------------------------
    -- Symbolic_Traceback --
    ------------------------
 
    function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
-      Status       : Cond_Value_Type;
+      Status            : Cond_Value_Type;
       Image_Name        : ASCIC;
       Image_Name_Addr   : Address;
       Module_Name       : ASCIC;
@@ -152,6 +224,11 @@ package body GNAT.Traceback.Symbolic is
             declare
                First : Integer := Len + 1;
                Last  : Integer := First + 80 - 1;
+               Pos   : Integer;
+               Routine_Name_D : String := Demangle_Ada
+                 (To_Ada
+                    (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
+                     False));
 
             begin
                Res (First .. Last) := (others => ' ');
@@ -168,13 +245,23 @@ package body GNAT.Traceback.Symbolic is
                    False);
 
                Res (First + 30 ..
-                    First + 30 + Integer (Routine_Name.Count) - 1) :=
-                 To_Ada
-                  (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
-                   False);
+                    First + 30 + Routine_Name_D'Length - 1) :=
+                 Routine_Name_D;
+
+               --  If routine name doesn't fit 20 characters, output
+               --  the line number on next line at 50th position
+
+               if Routine_Name_D'Length > 20 then
+                  Pos := First + 30 + Routine_Name_D'Length;
+                  Res (Pos) := ASCII.LF;
+                  Last := Pos + 80;
+                  Res (Pos + 1 .. Last) := (others => ' ');
+                  Pos := Pos + 51;
+               else
+                  Pos := First + 50;
+               end if;
 
-               Res (First + 50 ..
-                    First + 50 + Integer'Image (Line_Number)'Length - 1) :=
+               Res (Pos .. Pos + Integer'Image (Line_Number)'Length - 1) :=
                  Integer'Image (Line_Number);
 
                Res (Last) := ASCII.LF;
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c6de5e02630..d34a2a45de3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2003-10-30  Vasiliy Fofanov  <fofanov@act-europe.fr>
+
+	* 3vtrasym.adb: 
+	Demangle Ada symbols returned by TBK$SYMBOLIZE. Correctly align line
+	numbers when symbol name is too long.
+
+2003-10-30  Ed Falis  <falis@gnat.com>
+
+	* g-signal.ads, g-signal.adb: New files
+
+	* impunit.adb: (Non_Imp_File_Names): Added "g-signal"
+
+	* Makefile.rtl: Introduce GNAT.Signals
+
+2003-10-30  Robert Dewar  <dewar@gnat.com>
+
+	* freeze.adb: Minor reformatting
+
+	* lib-writ.adb (Write_ALI): Never write ali file if -gnats is specified
+
+	* par.adb, par-ch12.adb, par-ch13.adb, par-ch2.adb, par-ch3.adb, 
+	par-ch5.adb, par-ch6.adb, par-ch9.adb, par-util.adb: 
+	New handling of Id_Check parameter to improve recognition of keywords
+	used as identifiers.
+	Update copyright notice to include 2003
+
 2003-10-29  Robert Dewar  <dewar@gnat.com>
 
 	* 3vtrasym.adb, 5vtraent.ads, sprint.adb,
@@ -8,10 +34,7 @@
 
 2003-10-29  Vasiliy Fofanov  <fofanov@act-europe.fr>
 
-	* 3vtrasym.adb: 
-	* 5vtraent.adb: 
-	* 5vtraent.ads: 
-	* tb-alvms.c: 
+	* 3vtrasym.adb, 5vtraent.adb, 5vtraent.ads, tb-alvms.c: 
 	Support for TBK$SYMBOLIZE-based symbolic traceback.
 
 2003-10-29  Jose Ruiz  <ruiz@act-europe.fr>
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index f44db99ba00..62da39743f9 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -38,6 +38,7 @@ GNATRTL_TASKING_OBJS= \
   g-boubuf$(objext) \
   g-boumai$(objext) \
   g-semaph$(objext) \
+  g-signal$(objext) \
   g-thread$(objext) \
   s-asthan$(objext) \
   s-inmaop$(objext) \
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 0ac32c3dd9e..68dc1776e02 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -124,7 +124,7 @@ package body Freeze is
    --  a subprogram type (i.e. an access to a subprogram).
 
    function Is_Fully_Defined (T : Entity_Id) return Boolean;
-   --  true if T is not private and has no private components, or has a full
+   --  True if T is not private and has no private components, or has a full
    --  view. Used to determine whether the designated type of an access type
    --  should be frozen when the access type is frozen. This is done when an
    --  allocator is frozen, or an expression that may involve attributes of
@@ -4262,12 +4262,12 @@ package body Freeze is
       elsif Is_Record_Type (T)
         and not Is_Private_Type (T)
       then
-
          --  Verify that the record type has no components with
          --  private types without completion.
 
          declare
             Comp : Entity_Id;
+
          begin
             Comp := First_Component (T);
 
diff --git a/gcc/ada/g-signal.adb b/gcc/ada/g-signal.adb
new file mode 100644
index 00000000000..605b3e72f91
--- /dev/null
+++ b/gcc/ada/g-signal.adb
@@ -0,0 +1,71 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUNTIME COMPONENTS                          --
+--                                                                          --
+--                         G N A T . S I G N A L S                          --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 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- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.Interrupts;
+
+package body GNAT.Signals is
+
+   package SI renames System.Interrupts;
+
+   ------------------
+   -- Block_Signal --
+   ------------------
+
+   procedure Block_Signal (Signal : Ada.Interrupts.Interrupt_ID) is
+   begin
+      SI.Block_Interrupt (SI.Interrupt_ID (Signal));
+   end Block_Signal;
+
+   ----------------
+   -- Is_Blocked --
+   ----------------
+
+   function Is_Blocked
+     (Signal : Ada.Interrupts.Interrupt_ID)
+      return Boolean
+   is
+   begin
+      return SI.Is_Blocked (SI.Interrupt_ID (Signal));
+   end Is_Blocked;
+
+   --------------------
+   -- Unblock_Signal --
+   --------------------
+
+   procedure Unblock_Signal (Signal : Ada.Interrupts.Interrupt_ID) is
+   begin
+      SI.Unblock_Interrupt (SI.Interrupt_ID (Signal));
+   end Unblock_Signal;
+
+end GNAT.Signals;
+
diff --git a/gcc/ada/g-signal.ads b/gcc/ada/g-signal.ads
new file mode 100644
index 00000000000..6939fe27386
--- /dev/null
+++ b/gcc/ada/g-signal.ads
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUNTIME COMPONENTS                          --
+--                                                                          --
+--                         G N A T . S I G N A L S                          --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 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- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Interrupts;
+
+--  This package provides operations for querying and setting the blocked
+--  status of signals.
+
+--  This package is supported only on targets where Ada.Interrupts.Interrupt_ID
+--  corresponds to software signals on the target, and where System.Interrupts
+--  provides the ability to block and unblock signals.
+
+package GNAT.Signals is
+
+   procedure Block_Signal (Signal : Ada.Interrupts.Interrupt_ID);
+   --  Block "Signal" at the process level
+
+   procedure Unblock_Signal (Signal : Ada.Interrupts.Interrupt_ID);
+   --  Unblock "Signal" at the process level
+
+   function Is_Blocked (Signal : Ada.Interrupts.Interrupt_ID)
+                       return Boolean;
+   --  "Signal" blocked at the process level?
+
+end GNAT.Signals;
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index fcc174b8a33..d2a8645fc19 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -229,6 +229,7 @@ package body Impunit is
      "g-regist",    -- GNAT.Registry
      "g-regpat",    -- GNAT.Regpat
      "g-semaph",    -- GNAT.Semaphores
+     "g-signal",    -- GNAT.Signals
      "g-socket",    -- GNAT.Sockets
      "g-souinf",    -- GNAT.Source_Info
      "g-speche",    -- GNAT.Spell_Checker
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 35248a49d9b..c359011f677 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -680,6 +680,13 @@ package body Lib.Writ is
    --  Start of processing for Writ_ALI
 
    begin
+      --  We never write an ALI file if the original operating mode was
+      --  syntax-only (-gnats switch used in compiler invocation line)
+
+      if Original_Operating_Mode = Check_Syntax then
+         return;
+      end if;
+
       --  Build sorted source dependency table. We do this right away,
       --  because it is referenced by Up_To_Date_ALI_File_Exists.
 
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 2b9adaf73ae..2880fe43678 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2001 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- --
@@ -367,12 +367,12 @@ package body Ch12 is
       --  bother to check for it being exceeded.
 
    begin
-      Idents (1) := P_Defining_Identifier;
+      Idents (1) := P_Defining_Identifier (C_Comma_Colon);
       Num_Idents := 1;
 
       while Comma_Present loop
          Num_Idents := Num_Idents + 1;
-         Idents (Num_Idents) := P_Defining_Identifier;
+         Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
       end loop;
 
       T_Colon;
@@ -873,7 +873,7 @@ package body Ch12 is
    begin
       Def_Node := New_Node (N_Formal_Package_Declaration, Prev_Token_Ptr);
       Scan; -- past PACKAGE
-      Set_Defining_Identifier (Def_Node, P_Defining_Identifier);
+      Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is));
       T_Is;
       T_New;
       Set_Name (Def_Node, P_Qualified_Simple_Name);
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index cfcc3807fc0..7a7e4798a85 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2001 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- --
@@ -92,7 +92,7 @@ package body Ch13 is
       --  Note that the name in a representation clause is always a simple
       --  name, even in the attribute case, see AI-300 which made this so!
 
-      Identifier_Node := P_Identifier;
+      Identifier_Node := P_Identifier (C_Use);
 
       --  Check case of qualified name to give good error message
 
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index 7064c5df578..dd58e1f9cdc 100644
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -47,7 +47,7 @@ package body Ch2 is
 
    --  Error recovery: can raise Error_Resync (cannot return Error)
 
-   function P_Identifier return Node_Id is
+   function P_Identifier (C : Id_Check := None) return Node_Id is
       Ident_Node : Node_Id;
 
    begin
@@ -61,7 +61,7 @@ package body Ch2 is
       --  If we have a reserved identifier, manufacture an identifier with
       --  a corresponding name after posting an appropriate error message
 
-      elsif Is_Reserved_Identifier then
+      elsif Is_Reserved_Identifier (C) then
          Scan_Reserved_Identifier (Force_Msg => False);
          Ident_Node := Token_Node;
          Scan; -- past the node
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index df156b93c05..8236c5897d7 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -164,7 +164,7 @@ package body Ch3 is
 
    --  Error recovery: can raise Error_Resync
 
-   function P_Defining_Identifier return Node_Id is
+   function P_Defining_Identifier (C : Id_Check := None) return Node_Id is
       Ident_Node : Node_Id;
 
    begin
@@ -179,7 +179,7 @@ package body Ch3 is
       --  If we have a reserved identifier, manufacture an identifier with
       --  a corresponding name after posting an appropriate error message
 
-      elsif Is_Reserved_Identifier then
+      elsif Is_Reserved_Identifier (C) then
          Scan_Reserved_Identifier (Force_Msg => True);
 
       --  Otherwise we have junk that cannot be interpreted as an identifier
@@ -262,7 +262,7 @@ package body Ch3 is
       Type_Loc := Token_Ptr;
       Type_Start_Col := Start_Column;
       T_Type;
-      Ident_Node := P_Defining_Identifier;
+      Ident_Node := P_Defining_Identifier (C_Is);
       Discr_Sloc := Token_Ptr;
 
       if P_Unknown_Discriminant_Part_Opt then
@@ -732,7 +732,7 @@ package body Ch3 is
    begin
       Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
       Scan; -- past SUBTYPE
-      Set_Defining_Identifier (Decl_Node, P_Defining_Identifier);
+      Set_Defining_Identifier (Decl_Node, P_Defining_Identifier (C_Is));
       TF_Is;
 
       if Token = Tok_New then
@@ -1090,7 +1090,7 @@ package body Ch3 is
    begin
       Ident_Sloc := Token_Ptr;
       Save_Scan_State (Scan_State); -- at first identifier
-      Idents (1) := P_Defining_Identifier;
+      Idents (1) := P_Defining_Identifier (C_Comma_Colon);
 
       --  If we have a colon after the identifier, then we can assume that
       --  this is in fact a valid identifier declaration and can steam ahead.
@@ -1104,7 +1104,7 @@ package body Ch3 is
 
          while Comma_Present loop
             Num_Idents := Num_Idents + 1;
-            Idents (Num_Idents) := P_Defining_Identifier;
+            Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
          end loop;
 
          Save_Scan_State (Scan_State); -- at colon
@@ -1685,7 +1685,7 @@ package body Ch3 is
       if Token = Tok_Char_Literal then
          return P_Defining_Character_Literal;
       else
-         return P_Defining_Identifier;
+         return P_Defining_Identifier (C_Comma_Right_Paren);
       end if;
    end P_Enumeration_Literal_Specification;
 
@@ -2278,12 +2278,12 @@ package body Ch3 is
          Specification_Loop : loop
 
             Ident_Sloc := Token_Ptr;
-            Idents (1) := P_Defining_Identifier;
+            Idents (1) := P_Defining_Identifier (C_Comma_Colon);
             Num_Idents := 1;
 
             while Comma_Present loop
                Num_Idents := Num_Idents + 1;
-               Idents (Num_Idents) := P_Defining_Identifier;
+               Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
             end loop;
 
             T_Colon;
@@ -2518,7 +2518,7 @@ package body Ch3 is
       Names_List := New_List;
 
       loop
-         Append (P_Identifier, Names_List);
+         Append (P_Identifier (C_Vertical_Bar_Arrow), Names_List);
          exit when Token /= Tok_Vertical_Bar;
          Scan; -- past |
       end loop;
@@ -2747,12 +2747,12 @@ package body Ch3 is
       end if;
 
       Ident_Sloc := Token_Ptr;
-      Idents (1) := P_Defining_Identifier;
+      Idents (1) := P_Defining_Identifier (C_Comma_Colon);
       Num_Idents := 1;
 
       while Comma_Present loop
          Num_Idents := Num_Idents + 1;
-         Idents (Num_Idents) := P_Defining_Identifier;
+         Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
       end loop;
 
       T_Colon;
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index e8c6f3d65d6..e45b0fafb59 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1004,7 +1004,7 @@ package body Ch5 is
    begin
       Label_Node := New_Node (N_Label, Token_Ptr);
       Scan; -- past <<
-      Set_Identifier (Label_Node, P_Identifier);
+      Set_Identifier (Label_Node, P_Identifier (C_Greater_Greater));
       T_Greater_Greater;
       Append_Elmt (Label_Node, Label_List);
       return Label_Node;
@@ -1621,7 +1621,7 @@ package body Ch5 is
         New_Node (N_Loop_Parameter_Specification, Token_Ptr);
 
       Save_Scan_State (Scan_State);
-      ID_Node := P_Defining_Identifier;
+      ID_Node := P_Defining_Identifier (C_In);
       Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
 
       if Token = Tok_Left_Paren then
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index e5dc9ffff68..cc0e8981740 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.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- --
@@ -593,6 +593,10 @@ package body Ch6 is
       --  True, a real dot has been scanned and we are positioned past it,
       --  if the result is False, the scan position is unchanged.
 
+      --------------
+      -- Real_Dot --
+      --------------
+
       function Real_Dot return Boolean is
          Scan_State  : Saved_Scan_State;
 
@@ -715,7 +719,7 @@ package body Ch6 is
          Set_Identifier_Casing (Current_Source_File, Determine_Token_Casing);
       end if;
 
-      Ident_Node := P_Identifier;
+      Ident_Node := P_Identifier (C_Dot);
       Merge_Identifier (Ident_Node, Tok_Return);
 
       --  Normal case (not child library unit name)
@@ -746,7 +750,7 @@ package body Ch6 is
             Name_Node := New_Node (N_Selected_Component, Token_Ptr);
             Scan; -- past period
             Set_Prefix (Name_Node, Prefix_Node);
-            Ident_Node := P_Identifier;
+            Ident_Node := P_Identifier (C_Dot);
             Set_Selector_Name (Name_Node, Ident_Node);
             Prefix_Node := Name_Node;
          end loop;
@@ -870,7 +874,7 @@ package body Ch6 is
 
             Ignore (Tok_Left_Paren);
             Ident_Sloc := Token_Ptr;
-            Idents (1) := P_Defining_Identifier;
+            Idents (1) := P_Defining_Identifier (C_Comma_Colon);
             Num_Idents := 1;
 
             Ident_Loop : loop
@@ -924,7 +928,7 @@ package body Ch6 is
 
                T_Comma;
                Num_Idents := Num_Idents + 1;
-               Idents (Num_Idents) := P_Defining_Identifier;
+               Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
             end loop Ident_Loop;
 
             --  Fall through the loop on encountering a colon, or deciding
diff --git a/gcc/ada/par-ch9.adb b/gcc/ada/par-ch9.adb
index e68c972d63f..6bfc409acce 100644
--- a/gcc/ada/par-ch9.adb
+++ b/gcc/ada/par-ch9.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- --
@@ -90,7 +90,7 @@ package body Ch9 is
 
       if Token = Tok_Body then
          Scan; -- past BODY
-         Name_Node := P_Defining_Identifier;
+         Name_Node := P_Defining_Identifier (C_Is);
          Scope.Table (Scope.Last).Labl := Name_Node;
 
          if Token = Tok_Left_Paren then
@@ -133,7 +133,7 @@ package body Ch9 is
 
          else
             Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
-            Name_Node := P_Defining_Identifier;
+            Name_Node := P_Defining_Identifier (C_Is);
             Set_Defining_Identifier (Task_Node, Name_Node);
             Scope.Table (Scope.Last).Labl := Name_Node;
 
@@ -141,7 +141,6 @@ package body Ch9 is
                Error_Msg_SC ("discriminant part not allowed for single task");
                Discard_Junk_List (P_Known_Discriminant_Part_Opt);
             end if;
-
          end if;
 
          --  Parse optional task definition. Note that P_Task_Definition scans
@@ -344,7 +343,7 @@ package body Ch9 is
 
       if Token = Tok_Body then
          Scan; -- past BODY
-         Name_Node := P_Defining_Identifier;
+         Name_Node := P_Defining_Identifier (C_Is);
          Scope.Table (Scope.Last).Labl := Name_Node;
 
          if Token = Tok_Left_Paren then
@@ -381,7 +380,7 @@ package body Ch9 is
             Scan; -- past TYPE
             Protected_Node :=
               New_Node (N_Protected_Type_Declaration, Protected_Sloc);
-            Name_Node := P_Defining_Identifier;
+            Name_Node := P_Defining_Identifier (C_Is);
             Set_Defining_Identifier (Protected_Node, Name_Node);
             Scope.Table (Scope.Last).Labl := Name_Node;
             Set_Discriminant_Specifications
@@ -390,7 +389,7 @@ package body Ch9 is
          else
             Protected_Node :=
               New_Node (N_Single_Protected_Declaration, Protected_Sloc);
-            Name_Node := P_Defining_Identifier;
+            Name_Node := P_Defining_Identifier (C_Is);
             Set_Defining_Identifier (Protected_Node, Name_Node);
 
             if Token = Tok_Left_Paren then
@@ -631,7 +630,8 @@ package body Ch9 is
       Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
       Scan; -- past ENTRY
 
-      Set_Defining_Identifier (Decl_Node, P_Defining_Identifier);
+      Set_Defining_Identifier
+        (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
 
       --  If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
 
@@ -719,7 +719,7 @@ package body Ch9 is
       Scan; -- past ACCEPT
       Scope.Table (Scope.Last).Labl := Token_Node;
 
-      Set_Entry_Direct_Name (Accept_Node, P_Identifier);
+      Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
 
       --  Left paren could be (Entry_Index) or Formal_Part, determine which
 
@@ -932,7 +932,7 @@ package body Ch9 is
    begin
       Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
       T_For; -- past FOR
-      Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier);
+      Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
       T_In;
       Set_Discrete_Subtype_Definition
         (Iterator_Node, P_Discrete_Subtype_Definition);
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index d7e2e15e33a..d23269ea88d 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -24,6 +24,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Csets; use Csets;
 with Uintp; use Uintp;
 
 with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
@@ -419,7 +420,7 @@ package body Util is
    -- Is_Reserved_Identifier --
    ----------------------------
 
-   function Is_Reserved_Identifier return Boolean is
+   function Is_Reserved_Identifier (C : Id_Check := None) return Boolean is
    begin
       if not Is_Reserved_Keyword (Token) then
          return False;
@@ -438,20 +439,88 @@ package body Util is
             --  keyword casing, then we return False, since it is pretty
             --  clearly intended to be a keyword.
 
-            if Ident_Casing /= Unknown
-              and then Key_Casing /= Unknown
-              and then Ident_Casing /= Key_Casing
-              and then Determine_Token_Casing = Key_Casing
+            if Ident_Casing = Unknown
+              or else Key_Casing = Unknown
+              or else Ident_Casing = Key_Casing
+              or else Determine_Token_Casing /= Key_Casing
             then
-               return False;
+               return True;
 
-            --  Otherwise assume that an identifier was intended
+            --  Here we have a keyword written clearly with keyword casing.
+            --  In default mode, we would not be willing to consider this as
+            --  a reserved identifier, but if C is set, we may still accept it
 
-            else
-               return True;
+            elsif C /= None then
+               declare
+                  Scan_State  : Saved_Scan_State;
+                  OK_Next_Tok : Boolean;
+
+               begin
+                  Save_Scan_State (Scan_State);
+                  Scan;
+
+                  if Token_Is_At_Start_Of_Line then
+                     return False;
+                  end if;
+
+                  case C is
+                     when None =>
+                        raise Program_Error;
+
+                     when C_Comma_Right_Paren =>
+                        OK_Next_Tok :=
+                          Token = Tok_Comma or else Token = Tok_Right_Paren;
+
+                     when C_Comma_Colon =>
+                        OK_Next_Tok :=
+                          Token = Tok_Comma or else Token = Tok_Colon;
+
+                     when C_Do =>
+                        OK_Next_Tok :=
+                          Token = Tok_Do;
+
+                     when C_Dot =>
+                        OK_Next_Tok :=
+                          Token = Tok_Dot;
+
+                     when C_Greater_Greater =>
+                        OK_Next_Tok :=
+                          Token = Tok_Greater_Greater;
+
+                     when C_In =>
+                        OK_Next_Tok :=
+                          Token = Tok_In;
+
+                     when C_Is =>
+                        OK_Next_Tok :=
+                          Token = Tok_Is;
+
+                     when C_Left_Paren_Semicolon =>
+                        OK_Next_Tok :=
+                          Token = Tok_Left_Paren or else Token = Tok_Semicolon;
+
+                     when C_Use =>
+                        OK_Next_Tok :=
+                          Token = Tok_Use;
+
+                     when C_Vertical_Bar_Arrow =>
+                        OK_Next_Tok :=
+                          Token = Tok_Vertical_Bar or else Token = Tok_Arrow;
+                  end case;
+
+                  Restore_Scan_State (Scan_State);
+
+                  if OK_Next_Tok then
+                     return True;
+                  end if;
+               end;
             end if;
          end;
       end if;
+
+      --  If we fall through it is not a reserved identifier
+
+      return False;
    end Is_Reserved_Identifier;
 
    ----------------------
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index b5365332fb3..56629ef436f 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -26,7 +26,6 @@
 
 with Atree;    use Atree;
 with Casing;   use Casing;
-with Csets;    use Csets;
 with Debug;    use Debug;
 with Elists;   use Elists;
 with Errout;   use Errout;
@@ -189,6 +188,73 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
    --   that there is a missing body, but it seems more reasonable to let the
    --   later semantic checking discover this.
 
+   ----------------------------------------------------
+   -- Handling of Reserved Words Used as Identifiers --
+   ----------------------------------------------------
+
+   --  Note: throughout the parser, the terms reserved word and keyword
+   --  are used interchangably to refer to the same set of reserved
+   --  keywords (including until, protected, etc).
+
+   --  If a reserved word is used in place of an identifier, the parser
+   --  where possible tries to recover gracefully. In particular, if the
+   --  keyword is clearly spelled using identifier casing, e.g. Until in
+   --  a source program using mixed case identifiers and lower case keywords,
+   --  then the keyword is treated as an identifier if it appears in a place
+   --  where an identifier is required.
+
+   --  The situation is more complex if the keyword is spelled with normal
+   --  keyword casing. In this case, the parser is more reluctant to
+   --  consider it to be intended as an identifier, unless it has some
+   --  further confirmation.
+
+   --  In the case of an identifier appearing in the identifier list of a
+   --  declaration, the appearence of a comma or colon right after the
+   --  keyword on the same line is taken as confirmation. For an enumeration
+   --  literal, a comma or right paren right after the identifier is also
+   --  treated as adequate confirmation.
+
+   --  The following type is used in calls to Is_Reserved_Identifier and
+   --  also to P_Defining_Identifier and P_Identifier. The default for all
+   --  these functins is that reserved words in reserved word case are not
+   --  considered to be reserved identifiers. The Id_Check value indicates
+   --  tokens, which if they appear immediately after the identifier, are
+   --  taken as confirming that the use of an identifier was expected
+
+   type Id_Check is
+     (None,
+      --  Default, no special token test
+
+      C_Comma_Right_Paren,
+      --  Consider as identifier if followed by comma or right paren
+
+      C_Comma_Colon,
+      --  Consider as identifier if followed by comma or colon
+
+      C_Do,
+      --  Consider as identifier if followed by DO
+
+      C_Dot,
+      --  Consider as identifier if followed by period
+
+      C_Greater_Greater,
+      --  Consider as identifier if followed by >>
+
+      C_In,
+      --  Consider as identifier if followed by IN
+
+      C_Is,
+      --  Consider as identifier if followed by IS
+
+      C_Left_Paren_Semicolon,
+      --  Consider as identifier if followed by left paren or semicolon
+
+      C_Use,
+      --  Consider as identifier if followed by USE
+
+      C_Vertical_Bar_Arrow);
+      --  Consider as identifier if followed by | or =>
+
    --------------------------------------------
    -- Handling IS Used in Place of Semicolon --
    --------------------------------------------
@@ -450,9 +516,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
    --  List that is created.
 
    package Ch2 is
-      function P_Identifier                           return Node_Id;
       function P_Pragma                               return Node_Id;
 
+      function P_Identifier (C : Id_Check := None) return Node_Id;
+      --  Scans out an identifier. The parameter C determines the treatment
+      --  of reserved identifiers. See declaration of Id_Check for details.
+
       function P_Pragmas_Opt return List_Id;
       --  This function scans for a sequence of pragmas in other than a
       --  declaration sequence or statement sequence context. All pragmas
@@ -482,7 +551,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       function P_Basic_Declarative_Items              return List_Id;
       function P_Constraint_Opt                       return Node_Id;
       function P_Declarative_Part                     return List_Id;
-      function P_Defining_Identifier                  return Node_Id;
       function P_Discrete_Choice_List                 return List_Id;
       function P_Discrete_Range                       return Node_Id;
       function P_Discrete_Subtype_Definition          return Node_Id;
@@ -503,6 +571,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  case where the source has a single declaration with multiple
       --  defining identifiers.
 
+      function P_Defining_Identifier (C : Id_Check := None) return Node_Id;
+      --  Scan out a defining identifier. The parameter C controls the
+      --  treatment of errors in case a reserved word is scanned. See the
+      --  declaration of this type for details.
+
       function Init_Expr_Opt (P : Boolean := False) return Node_Id;
       --  If an initialization expression is present (:= expression), then
       --  it is scanned out and returned, otherwise Empty is returned if no
@@ -908,10 +981,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  past it, otherwise the call has no effect at all. T may be any
       --  reserved word token, or comma, left or right paren, or semicolon.
 
-      function Is_Reserved_Identifier return Boolean;
+      function Is_Reserved_Identifier (C : Id_Check := None) return Boolean;
       --  Test if current token is a reserved identifier. This test is based
       --  on the token being a keyword and being spelled in typical identifier
-      --  style (i.e. starting with an upper case letter).
+      --  style (i.e. starting with an upper case letter). The parameter C
+      --  determines the special treatment if a reserved word is encountered
+      --  that has the normal casing of a reserved word.
 
       procedure Merge_Identifier (Prev : Node_Id; Nxt : Token_Type);
       --  Called when the previous token is an identifier (whose Token_Node