[multiple changes]

2005-03-17 Vasiliy Fofanov <fofanov@adacore.com> * gnat_ugn.texi: Document gnatmem restriction 2005-03-17 Thomas Quinot <quinot@adacore.com> * snames.adb: Document new TSS names introduced by exp_dist/exp_tss cleanup 2005-03-17 Robert Dewar <dewar@adacore.com> * s-interr.ads, s-interr.adb, sem_ch3.adb, prj.ads, prj.adb, a-interr.adb, a-interr.ads, s-interr-sigaction.adb, s-interr-dummy.adb, s-interr-vms.adb, s-interr-vxworks.adb: Minor reformatting * casing.adb: Comment improvements 2005-03-17 Pascal Obry <obry@adacore.com> * g-expect.adb: Minor reformatting. From-SVN: r96678

[multiple changes]
2005-03-17 Vasiliy Fofanov <fofanov@adacore.com> * gnat_ugn.texi: Document gnatmem restriction 2005-03-17 Thomas Quinot <quinot@adacore.com> * snames.adb: Document new TSS names introduced by exp_dist/exp_tss cleanup 2005-03-17 Robert Dewar <dewar@adacore.com> * s-interr.ads, s-interr.adb, sem_ch3.adb, prj.ads, prj.adb, a-interr.adb, a-interr.ads, s-interr-sigaction.adb, s-interr-dummy.adb, s-interr-vms.adb, s-interr-vxworks.adb: Minor reformatting * casing.adb: Comment improvements 2005-03-17 Pascal Obry <obry@adacore.com> * g-expect.adb: Minor reformatting. From-SVN: r96678
fa7c4d23 · Arnaud Charlet · 8095d0fa · fa7c4d23 · fa7c4d23 · fa7c4d23
Commit fa7c4d23 authored Mar 18, 2005 by Arnaud Charlet
15 changed files
--- a/gcc/ada/a-interr.adb
+++ b/gcc/ada/a-interr.adb
@@ -7,7 +7,7 @@
 --                                  B o d y                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
--             Copyright (C) 1995-2003, Ada Core Technologies               --
+--                      Copyright (C) 1995-2005 AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -73,8 +73,7 @@ package body Ada.Interrupts is
   ---------------------
   function Current_Handler
-     (Interrupt : Interrupt_ID)
+     (Interrupt : Interrupt_ID) return Parameterless_Handler
-      return      Parameterless_Handler
   is
   begin
      return To_Ada (SI.Current_Handler (SI.Interrupt_ID (Interrupt)));
@@ -84,7 +83,7 @@ package body Ada.Interrupts is
   -- Detach_Handler --
   --------------------
-   procedure Detach_Handler (Interrupt : in Interrupt_ID) is
+   procedure Detach_Handler (Interrupt : Interrupt_ID) is
   begin
      SI.Detach_Handler (SI.Interrupt_ID (Interrupt), False);
   end Detach_Handler;

--- a/gcc/ada/a-interr.ads
+++ b/gcc/ada/a-interr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
--          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -49,8 +49,7 @@ package Ada.Interrupts is
   function Is_Attached (Interrupt : Interrupt_ID) return Boolean;
   function Current_Handler
-     (Interrupt : Interrupt_ID)
+     (Interrupt : Interrupt_ID) return Parameterless_Handler;
-      return      Parameterless_Handler;
   procedure Attach_Handler
     (New_Handler : Parameterless_Handler;

--- a/gcc/ada/casing.adb
+++ b/gcc/ada/casing.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
--          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -140,6 +140,17 @@ package body Casing is
      Ptr := 1;
      while Ptr <= Name_Len loop
+         --  Wide character. Note that we do nothing with casing in this case.
+         --  In Ada 2005 mode, required folding of lower case letters happened
+         --  as the identifier was scanned, and we do not attempt any further
+         --  messing with case (note that in any case we do not know how to
+         --  fold upper case to lower case in wide character mode). We also
+         --  do not bother with recognizing punctuation as equivalent to an
+         --  underscore. There is nothing functional at this stage in doing
+         --  the requested casing operation, beyond folding to upper case
+         --  when it is mandatory, which does not involve underscores.
         if Name_Buffer (Ptr) = ASCII.ESC
           or else Name_Buffer (Ptr) = '['
           or else (Upper_Half_Encoding
@@ -148,12 +159,16 @@ package body Casing is
            Skip_Wide (Name_Buffer, Ptr);
            After_Und := False;
+         --  Underscore, or non-identifer character (error case)
         elsif Name_Buffer (Ptr) = '_'
            or else not Identifier_Char (Name_Buffer (Ptr))
         then
            After_Und := True;
            Ptr := Ptr + 1;
+         --  Lower case letter
         elsif Is_Lower_Case_Letter (Name_Buffer (Ptr)) then
            if Actual_Casing = All_Upper_Case
              or else (After_Und and then Actual_Casing = Mixed_Case)
@@ -164,6 +179,8 @@ package body Casing is
            After_Und := False;
            Ptr := Ptr + 1;
+         --  Upper case letter
         elsif Is_Upper_Case_Letter (Name_Buffer (Ptr)) then
            if Actual_Casing = All_Lower_Case
              or else (not After_Und and then Actual_Casing = Mixed_Case)
@@ -174,7 +191,9 @@ package body Casing is
            After_Und := False;
            Ptr := Ptr + 1;
-         else  --  all other characters
+         --  Other identifier character (must be digit)
+         else
            After_Und := False;
            Ptr := Ptr + 1;
         end if;

--- a/gcc/ada/g-expect.adb
+++ b/gcc/ada/g-expect.adb
@@ -31,12 +31,12 @@
 --                                                                          --
 ------------------------------------------------------------------------------
-with System;        use System;
+with System;       use System;
-with Ada.Calendar;  use Ada.Calendar;
+with Ada.Calendar; use Ada.Calendar;
 with GNAT.IO;
-with GNAT.OS_Lib;   use GNAT.OS_Lib;
+with GNAT.OS_Lib;  use GNAT.OS_Lib;
-with GNAT.Regpat;   use GNAT.Regpat;
+with GNAT.Regpat;  use GNAT.Regpat;
 with Unchecked_Deallocation;
@@ -762,9 +762,7 @@ package body GNAT.Expect is
   ------------------
   function Get_Error_Fd
-     (Descriptor : Process_Descriptor)
+     (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
-      return       GNAT.OS_Lib.File_Descriptor
-   is
   begin
      return Descriptor.Error_Fd;
   end Get_Error_Fd;
@@ -774,9 +772,7 @@ package body GNAT.Expect is
   ------------------
   function Get_Input_Fd
-     (Descriptor : Process_Descriptor)
+     (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
-      return       GNAT.OS_Lib.File_Descriptor
-   is
   begin
      return Descriptor.Input_Fd;
   end Get_Input_Fd;
@@ -786,9 +782,7 @@ package body GNAT.Expect is
   -------------------
   function Get_Output_Fd
-     (Descriptor : Process_Descriptor)
+     (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
-      return       GNAT.OS_Lib.File_Descriptor
-   is
   begin
      return Descriptor.Output_Fd;
   end Get_Output_Fd;
@@ -798,9 +792,7 @@ package body GNAT.Expect is
   -------------
   function Get_Pid
-     (Descriptor : Process_Descriptor)
+     (Descriptor : Process_Descriptor) return Process_Id is
-      return       Process_Id
-   is
   begin
      return Descriptor.Pid;
   end Get_Pid;
@@ -847,7 +839,7 @@ package body GNAT.Expect is
      Arg        : String_Access;
      Arg_List   : String_List (1 .. Args'Length + 2);
-      C_Arg_List :  aliased array (1 .. Args'Length + 2) of System.Address;
+      C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address;
      Command_With_Path : String_Access;
@@ -1004,9 +996,9 @@ package body GNAT.Expect is
   ----------
   procedure Send
-     (Descriptor : in out Process_Descriptor;
+     (Descriptor   : in out Process_Descriptor;
-      Str        : String;
+      Str          : String;
-      Add_LF     : Boolean := True;
+      Add_LF       : Boolean := True;
      Empty_Buffer : Boolean := False)
   is
      Full_Str    : constant String := Str & ASCII.LF;

--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -18140,7 +18140,7 @@ allocation and deallocation routines that record call information. This
 allows to obtain accurate dynamic memory usage history at a minimal cost to
 the execution speed. Note however, that @code{gnatmem} is not supported on
 all platforms (currently, it is supported on AIX, HP-UX, GNU/Linux x86,
-Solaris (sparc and x86) and Windows NT/2000/XP (x86).
+32-bit Solaris (sparc and x86) and Windows NT/2000/XP (x86).
 @noindent
 The @code{gnatmem} command has the form

--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -650,7 +650,7 @@ package body Prj is
   end Set;
   procedure Set
-     (Language_Processing : in Language_Processing_Data;
+     (Language_Processing : Language_Processing_Data;
      For_Language        : Language_Index;
      In_Project          : in out Project_Data;
      In_Tree             : Project_Tree_Ref)
@@ -672,8 +672,7 @@ package body Prj is
            begin
               while Supp_Index /= No_Supp_Language_Index loop
-                  Supp := In_Tree.Supp_Languages.Table
+                  Supp := In_Tree.Supp_Languages.Table (Supp_Index);
-                                                                (Supp_Index);
                  if Supp.Index = For_Language then
                     In_Tree.Supp_Languages.Table
@@ -755,8 +754,8 @@ package body Prj is
   -- Standard_Naming_Data --
   --------------------------
-   function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree)
+   function Standard_Naming_Data
-                                  return Naming_Data
+     (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
   is
   begin
      if Tree = No_Project_Tree then
@@ -793,8 +792,7 @@ package body Prj is
            begin
               while Supp_Index /= No_Supp_Language_Index loop
-                  Supp := In_Tree.Supp_Suffixes.Table
+                  Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
-                                                             (Supp_Index);
                  if Supp.Index = Language then
                     return Supp.Suffix;

--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -513,8 +513,8 @@ package Prj is
   end record;
-   function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree)
+   function Standard_Naming_Data
-                                  return Naming_Data;
+     (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data;
   pragma Inline (Standard_Naming_Data);
   --  The standard GNAT naming scheme when Tree is No_Project_Tree.
   --  Otherwise, return the default naming scheme for the project tree Tree,

--- a/gcc/ada/s-interr-dummy.adb
+++ b/gcc/ada/s-interr-dummy.adb
@@ -7,7 +7,7 @@
 --                                  B o d y                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
--             Copyright (C) 1995-2004, Ada Core Technologies               --
+--                      Copyright (C) 1995-2005 AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -32,10 +32,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
--  This is an OS/2 version of this package.
+--  This version is for systems that do not support interrupts (or signals)
--  This version is a stub, for systems that
--  do not support interrupts (or signals).
 with Ada.Exceptions;
@@ -93,8 +90,7 @@ package body System.Interrupts is
   ---------------------
   function Current_Handler
-     (Interrupt : Interrupt_ID)
+     (Interrupt : Interrupt_ID) return Parameterless_Handler
-      return      Parameterless_Handler
   is
   begin
      Unimplemented;
@@ -155,7 +151,6 @@ package body System.Interrupts is
      return   Boolean
   is
      pragma Warnings (Off, Object);
   begin
      Unimplemented;
      return True;
@@ -166,7 +161,6 @@ package body System.Interrupts is
      return   Boolean
   is
      pragma Warnings (Off, Object);
   begin
      Unimplemented;
      return True;

--- a/gcc/ada/s-interr-sigaction.adb
+++ b/gcc/ada/s-interr-sigaction.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
--              Copyright (C) 1998-2004 Free Software Fundation             --
+--              Copyright (C) 1998-2005 Free Software Fundation             --
 --                                                                          --
 -- 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- --
@@ -31,7 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
--  This is the IRIX & NT version of this package.
+--  This is the IRIX & NT version of this package
 with Ada.Task_Identification;
 --  used for Task_Id
@@ -120,15 +120,15 @@ package body System.Interrupts is
   --  that contain interrupt handlers.
   procedure Signal_Handler (Sig : Interrupt_ID);
-   --  This procedure is used to handle all the signals.
+   --  This procedure is used to handle all the signals
   --  Type and Head, Tail of the list containing Registered Interrupt
   --  Handlers. These definitions are used to register the handlers
   --  specified by the pragma Interrupt_Handler.
-   --
+   --------------------------
-   --  Handler Registration:
+   -- Handler Registration --
-   --
+   --------------------------
   type Registered_Handler;
   type R_Link is access all Registered_Handler;
@@ -362,15 +362,14 @@ package body System.Interrupts is
      if not Restoration and then not Static
-         --  Tries to overwrite a static Interrupt Handler with a
+         --  Tries to overwrite a static Interrupt Handler with dynamic handle
-         --  dynamic Handler
-        and then (Descriptors (Interrupt).Static
+        and then
+          (Descriptors (Interrupt).Static
-                     --  The new handler is not specified as an
+            --  New handler not specified as an Interrupt Handler by a pragma
-                     --  Interrupt Handler by a pragma.
-                     or else not Is_Registered (New_Handler))
+             or else not Is_Registered (New_Handler))
      then
         Raise_Exception (Program_Error'Identity,
           "Trying to overwrite a static Interrupt Handler with a " &
@@ -569,10 +568,10 @@ package body System.Interrupts is
      Descriptors (Interrupt).T := T;
      Descriptors (Interrupt).E := E;
-      --  Indicate the attachment of Interrupt Entry in ATCB.
+      --  Indicate the attachment of Interrupt Entry in ATCB. This is needed so
-      --  This is need so that when an Interrupt Entry task terminates
+      --  that when an Interrupt Entry task terminates the binding can be
-      --  the binding can be cleaned. The call to unbinding must be
+      --  cleaned up. The call to unbinding must be make by the task before it
-      --  make by the task before it terminates.
+      --  terminates.
      T.Interrupt_Entry := True;
   end Bind_Interrupt_To_Entry;
@@ -597,7 +596,7 @@ package body System.Interrupts is
         end if;
      end loop;
-      --  Indicate in ATCB that no Interrupt Entries are attached.
+      --  Indicate in ATCB that no Interrupt Entries are attached
      T.Interrupt_Entry := True;
   end Detach_Interrupt_Entries;
@@ -674,8 +673,8 @@ package body System.Interrupts is
         Initialization.Undefer_Abort (Self_Id);
-         --  Undefer abort here to allow a window for this task
+         --  Undefer abort here to allow a window for this task to be aborted
-         --  to be aborted  at the time of system shutdown.
+         --  at the time of system shutdown.
      end loop;
   end Server_Task;

--- a/gcc/ada/s-interr-vms.adb
+++ b/gcc/ada/s-interr-vms.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
--         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2005, 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- --
@@ -31,7 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
--  This is an OpenVMS/Alpha version of this package.
+--  This is an OpenVMS/Alpha version of this package
 --  Invariants:
@@ -140,9 +140,8 @@ package body System.Interrupts is
   -- Local Tasks --
   -----------------
-   --  WARNING: System.Tasking.Stages performs calls to this task
+   --  WARNING: System.Tasking.Stages performs calls to this task with
-   --  with low-level constructs. Do not change this spec without synchro-
+   --  low-level constructs. Do not change this spec without synchronizing it.
-   --  nizing it.
   task Interrupt_Manager is
      entry Detach_Interrupt_Entries (T : Task_Id);
@@ -183,10 +182,10 @@ package body System.Interrupts is
   task type Server_Task (Interrupt : Interrupt_ID) is
      pragma Priority (System.Interrupt_Priority'Last);
-      --  Note: the above pragma Priority is strictly speaking improper
+      --  Note: the above pragma Priority is strictly speaking improper since
-      --  since it is outside the range of allowed priorities, but the
+      --  it is outside the range of allowed priorities, but the compiler
-      --  compiler treats system units specially and does not apply
+      --  treats system units specially and does not apply this range checking
-      --  this range checking rule to system units.
+      --  rule to system units.
   end Server_Task;
@@ -210,9 +209,9 @@ package body System.Interrupts is
                    (others => (null, Static => False));
   pragma Volatile_Components (User_Handler);
   --  Holds the protected procedure handler (if any) and its Static
-   --  information  for each interrupt. A handler is a Static one if
+   --  information for each interrupt. A handler is a Static one if it is
-   --  it is specified through the pragma Attach_Handler.
+   --  specified through the pragma Attach_Handler. Attach_Handler. Otherwise,
-   --  Attach_Handler. Otherwise, not static)
+   --  not static)
   User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
                  (others => (T => Null_Task, E => Null_Task_Entry));
@@ -221,7 +220,7 @@ package body System.Interrupts is
   Blocked : constant array (Interrupt_ID'Range) of Boolean :=
     (others => False);
--  ??? pragma Volatile_Components (Blocked);
+   --  ??? pragma Volatile_Components (Blocked);
   --  True iff the corresponding interrupt is blocked in the process level
   Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
@@ -238,13 +237,13 @@ package body System.Interrupts is
   Server_ID : array (Interrupt_ID'Range) of Task_Id :=
                 (others => Null_Task);
   pragma Atomic_Components (Server_ID);
-   --  Holds the Task_Id of the Server_Task for each interrupt.
+   --  Holds the Task_Id of the Server_Task for each interrupt. Task_Id is
-   --  Task_Id is needed to accomplish locking per Interrupt base. Also
+   --  needed to accomplish locking per Interrupt base. Also is needed to
-   --  is needed to decide whether to create a new Server_Task.
+   --  decide whether to create a new Server_Task.
   --  Type and Head, Tail of the list containing Registered Interrupt
-   --  Handlers. These definitions are used to register the handlers
+   --  Handlers. These definitions are used to register the handlers specified
-   --  specified by the pragma Interrupt_Handler.
+   --  by the pragma Interrupt_Handler.
   type Registered_Handler;
   type R_Link is access all Registered_Handler;
@@ -334,7 +333,6 @@ package body System.Interrupts is
      end loop;
      return False;
   end Is_Registered;
   -----------------
@@ -415,9 +413,9 @@ package body System.Interrupts is
           Interrupt_ID'Image (Interrupt) & " is reserved");
      end if;
-      --  ??? Since Parameterless_Handler is not Atomic, the
+      --  ??? Since Parameterless_Handler is not Atomic, the current
-      --  current implementation is wrong. We need a new service in
+      --  implementation is wrong. We need a new service in Interrupt_Manager
-      --  Interrupt_Manager to ensure atomicity.
+      --  to ensure atomicity.
      return User_Handler (Interrupt).H;
   end Current_Handler;
@@ -452,19 +450,20 @@ package body System.Interrupts is
   -- Exchange_Handler --
   ----------------------
-   --  Calling this procedure with New_Handler = null and Static = True
+   --  Calling this procedure with New_Handler = null and Static = True means
-   --  means we want to detach the current handler regardless of the
+   --  we want to detach the current handler regardless of the previous
-   --  previous handler's binding status (ie. do not care if it is a
+   --  handler's binding status (ie. do not care if it is dynamic or static
-   --  dynamic or static handler).
+   --  handler).
-   --  This option is needed so that during the finalization of a PO, we
+   --  This option is needed so that during the finalization of a PO, we can
-   --  can detach handlers attached through pragma Attach_Handler.
+   --  detach handlers attached through pragma Attach_Handler.
   procedure Exchange_Handler
     (Old_Handler : out Parameterless_Handler;
      New_Handler : Parameterless_Handler;
      Interrupt   : Interrupt_ID;
-      Static      : Boolean := False) is
+      Static      : Boolean := False)
+   is
   begin
      if Is_Reserved (Interrupt) then
         Raise_Exception (Program_Error'Identity, "Interrupt" &
@@ -1152,25 +1151,24 @@ package body System.Interrupts is
   end Install_Handlers;
 --  Elaboration code for package System.Interrupts
 begin
   --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
   Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
-   --  During the elaboration of this package body we want RTS to
+   --  During the elaboration of this package body we want RTS to inherit the
-   --  inherit the interrupt mask from the Environment Task.
+   --  interrupt mask from the Environment Task.
-   --  The Environment Task should have gotten its mask from
+   --  The Environment Task should have gotten its mask from the enclosing
-   --  the enclosing process during the RTS start up. (See
+   --  process during the RTS start up. (See in s-inmaop.adb). Pass the
-   --  in s-inmaop.adb). Pass the Interrupt_Mask of the Environment
+   --  Interrupt_Mask of the Environment task to the Interrupt_Manager.
-   --  task to the Interrupt_Manager.
-   --  Note : At this point we know that all tasks (including
+   --  Note : At this point we know that all tasks (including RTS internal
-   --  RTS internal servers) are masked for non-reserved signals
+   --  servers) are masked for non-reserved signals (see s-taprop.adb). Only
-   --  (see s-taprop.adb). Only the Interrupt_Manager will have
+   --  the Interrupt_Manager will have masks set up differently inheriting the
-   --  masks set up differently inheriting the original Environment
+   --  original Environment Task's mask.
-   --  Task's mask.
   Interrupt_Manager.Initialize (IMOP.Environment_Mask);
 end System.Interrupts;
--- a/gcc/ada/s-interr-vxworks.adb
+++ b/gcc/ada/s-interr-vxworks.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
--         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2005, 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- --
@@ -33,27 +33,27 @@
 --  Invariants:
--  All user-handleable signals are masked at all times in all
+--  All user-handleable signals are masked at all times in all tasks/threads
--  tasks/threads except possibly for the Interrupt_Manager task.
+--  except possibly for the Interrupt_Manager task.
--  When a user task wants to have the effect of masking/unmasking an
+--  When a user task wants to have the effect of masking/unmasking an signal,
--  signal, it must call Block_Interrupt/Unblock_Interrupt, which
+--  it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
--  will have the effect of unmasking/masking the signal in the
+--  of unmasking/masking the signal in the Interrupt_Manager task. These
--  Interrupt_Manager task.  These comments do not apply to vectored
+--  comments do not apply to vectored hardware interrupts, which may be masked
--  hardware interrupts, which may be masked or unmasked using routined
+--  or unmasked using routined interfaced to the relevant VxWorks system
--  interfaced to the relevant VxWorks system calls.
+--  calls.
--  Once we associate a Signal_Server_Task with an signal, the task never
+--  Once we associate a Signal_Server_Task with an signal, the task never goes
--  goes away, and we never remove the association. On the other hand, it
+--  away, and we never remove the association. On the other hand, it is more
--  is more convenient to terminate an associated Interrupt_Server_Task
+--  convenient to terminate an associated Interrupt_Server_Task for a vectored
--  for a vectored hardware interrupt (since we use a binary semaphore
+--  hardware interrupt (since we use a binary semaphore for synchronization
--  for synchronization with the umbrella handler).
+--  with the umbrella handler).
 --  There is no more than one signal per Signal_Server_Task and no more than
--  one Signal_Server_Task per signal.  The same relation holds for hardware
+--  one Signal_Server_Task per signal. The same relation holds for hardware
--  interrupts and Interrupt_Server_Task's at any given time.  That is,
+--  interrupts and Interrupt_Server_Task's at any given time. That is, only
--  only one non-terminated Interrupt_Server_Task exists for a give
+--  one non-terminated Interrupt_Server_Task exists for a give interrupt at
--  interrupt at any time.
+--  any time.
 --  Within this package, the lock L is used to protect the various status
 --  tables. If there is a Server_Task associated with a signal or interrupt,
@@ -124,9 +124,8 @@ package body System.Interrupts is
   -- Local Tasks --
   -----------------
-   --  WARNING: System.Tasking.Stages performs calls to this task
+   --  WARNING: System.Tasking.Stages performs calls to this task with
-   --  with low-level constructs. Do not change this spec without synchro-
+   --  low-level constructs. Do not change this spec without synchronizing it.
-   --  nizing it.
   task Interrupt_Manager is
      entry Detach_Interrupt_Entries (T : Task_Id);
@@ -331,7 +330,8 @@ package body System.Interrupts is
   ---------------------
   function Current_Handler
-     (Interrupt : Interrupt_ID) return Parameterless_Handler is
+     (Interrupt : Interrupt_ID) return Parameterless_Handler
+   is
   begin
      Check_Reserved_Interrupt (Interrupt);
@@ -386,7 +386,8 @@ package body System.Interrupts is
     (Old_Handler : out Parameterless_Handler;
      New_Handler : Parameterless_Handler;
      Interrupt   : Interrupt_ID;
-      Static      : Boolean := False) is
+      Static      : Boolean := False)
+   is
   begin
      Check_Reserved_Interrupt (Interrupt);
      Interrupt_Manager.Exchange_Handler
@@ -421,7 +422,7 @@ package body System.Interrupts is
   -- Finalize_Interrupt_Servers --
   --------------------------------
-   --  Restore default handlers for interrupt servers.
+   --  Restore default handlers for interrupt servers
   --  This is called by the Interrupt_Manager task when it receives the abort
   --  signal during program finalization.
@@ -456,7 +457,6 @@ package body System.Interrupts is
      return   Boolean
   is
      pragma Unreferenced (Object);
   begin
      return True;
   end Has_Interrupt_Or_Attach_Handler;
@@ -466,7 +466,6 @@ package body System.Interrupts is
      return   Boolean
   is
      pragma Unreferenced (Object);
   begin
      return True;
   end Has_Interrupt_Or_Attach_Handler;
@@ -500,9 +499,11 @@ package body System.Interrupts is
   procedure Install_Handlers
     (Object       : access Static_Interrupt_Protection;
-      New_Handlers : New_Handler_Array) is
+      New_Handlers : New_Handler_Array)
+   is
   begin
      for N in New_Handlers'Range loop
         --  We need a lock around this ???
         Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
@@ -687,6 +688,7 @@ package body System.Interrupts is
   procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
      New_Node_Ptr : R_Link;
   begin
      --  This routine registers a handler as usable for dynamic
      --  interrupt handler association. Routines attaching and detaching
@@ -727,7 +729,8 @@ package body System.Interrupts is
   ------------------
   function Unblocked_By
-     (Interrupt : Interrupt_ID) return System.Tasking.Task_Id is
+     (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
+   is
   begin
      Unimplemented ("Unblocked_By");
      return Null_Task;
@@ -836,8 +839,9 @@ package body System.Interrupts is
         --  status of the Current_Handler.
         if not Static and then User_Handler (Interrupt).Static then
-            --  Trying to detach a static Interrupt Handler.
-            --  raise Program_Error.
+            --  Trying to detach a static Interrupt Handler. raise
+            --  Program_Error.
            Raise_Exception (Program_Error'Identity,
              "Trying to detach a static Interrupt Handler");
@@ -864,9 +868,11 @@ package body System.Interrupts is
         New_Handler : Parameterless_Handler;
         Interrupt   : Interrupt_ID;
         Static      : Boolean;
-         Restoration : Boolean := False) is
+         Restoration : Boolean := False)
+      is
      begin
         if User_Entry (Interrupt).T /= Null_Task then
            --  If an interrupt entry is already installed, raise
            --  Program_Error. (propagate it to the caller).
@@ -909,7 +915,7 @@ package body System.Interrupts is
         if New_Handler = null then
-            --  The null handler means we are detaching the handler.
+            --  The null handler means we are detaching the handler
            User_Handler (Interrupt).Static := False;
@@ -935,11 +941,13 @@ package body System.Interrupts is
         end if;
         if (New_Handler = null) and then Old_Handler /= null then
            --  Restore default handler
            Unbind_Handler (Interrupt);
         elsif Old_Handler = null then
            --  Save default handler
            Bind_Handler (Interrupt);
@@ -1046,7 +1054,7 @@ package body System.Interrupts is
                     end if;
                  end loop;
-                  --  Indicate in ATCB that no interrupt entries are attached.
+                  --  Indicate in ATCB that no interrupt entries are attached
                  T.Interrupt_Entry := False;
               end Detach_Interrupt_Entries;
@@ -1140,7 +1148,7 @@ package body System.Interrupts is
   end Interrupt_Server_Task;
 begin
-   --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
+   --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
   Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
 end System.Interrupts;
--- a/gcc/ada/s-interr.adb
+++ b/gcc/ada/s-interr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
--         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2005, 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- --
@@ -157,20 +157,20 @@ package body System.Interrupts is
      entry Initialize (Mask : IMNG.Interrupt_Mask);
      entry Attach_Handler
-        (New_Handler : in Parameterless_Handler;
+        (New_Handler : Parameterless_Handler;
-         Interrupt   : in Interrupt_ID;
+         Interrupt   : Interrupt_ID;
-         Static      : in Boolean;
+         Static      : Boolean;
-         Restoration : in Boolean := False);
+         Restoration : Boolean := False);
      entry Exchange_Handler
        (Old_Handler : out Parameterless_Handler;
-         New_Handler : in Parameterless_Handler;
+         New_Handler : Parameterless_Handler;
-         Interrupt   : in Interrupt_ID;
+         Interrupt   : Interrupt_ID;
-         Static      : in Boolean);
+         Static      : Boolean);
      entry Detach_Handler
-        (Interrupt   : in Interrupt_ID;
+        (Interrupt   : Interrupt_ID;
-         Static      : in Boolean);
+         Static      : Boolean);
      entry Bind_Interrupt_To_Entry
        (T         : Task_Id;
@@ -256,7 +256,7 @@ package body System.Interrupts is
   type R_Link is access all Registered_Handler;
   type Registered_Handler is record
-      H :    System.Address := System.Null_Address;
+      H    : System.Address := System.Null_Address;
      Next : R_Link := null;
   end record;
@@ -287,9 +287,9 @@ package body System.Interrupts is
   --  can detach handlers attached through pragma Attach_Handler.
   procedure Attach_Handler
-     (New_Handler : in Parameterless_Handler;
+     (New_Handler : Parameterless_Handler;
-      Interrupt   : in Interrupt_ID;
+      Interrupt   : Interrupt_ID;
-      Static      : in Boolean := False)
+      Static      : Boolean := False)
   is
   begin
      if Is_Reserved (Interrupt) then
@@ -352,9 +352,9 @@ package body System.Interrupts is
           Interrupt_ID'Image (Interrupt) & " is reserved");
      end if;
-      --  ??? Since Parameterless_Handler is not Atomic, the
+      --  ??? Since Parameterless_Handler is not Atomic, the current
-      --  current implementation is wrong. We need a new service in
+      --  implementation is wrong. We need a new service in Interrupt_Manager
-      --  Interrupt_Manager to ensure atomicity.
+      --  to ensure atomicity.
      return User_Handler (Interrupt).H;
   end Current_Handler;
@@ -632,15 +632,15 @@ package body System.Interrupts is
      New_Node_Ptr : R_Link;
   begin
-      --  This routine registers the Handler as usable for Dynamic
+      --  This routine registers the Handler as usable for Dynamic Interrupt
-      --  Interrupt Handler. Routines attaching and detaching Handler
+      --  Handler. Routines attaching and detaching Handler dynamically should
-      --  dynamically should first consult if the Handler is rgistered.
+      --  first consult if the Handler is registered. A Program Error should
-      --  A Program Error should be raised if it is not registered.
+      --  be raised if it is not registered.
-      --  The pragma Interrupt_Handler can only appear in the library
+      --  The pragma Interrupt_Handler can only appear in the library level PO
-      --  level PO definition and instantiation. Therefore, we do not need
+      --  definition and instantiation. Therefore, we do not need to implement
-      --  to implement Unregistering operation. Neither we need to
+      --  Unregistering operation. Neither we need to protect the queue
-      --  protect the queue structure using a Lock.
+      --  structure using a Lock.
      pragma Assert (Handler_Addr /= System.Null_Address);
@@ -1014,10 +1014,10 @@ package body System.Interrupts is
         begin
            select
               accept Attach_Handler
-                  (New_Handler : in Parameterless_Handler;
+                  (New_Handler : Parameterless_Handler;
-                   Interrupt   : in Interrupt_ID;
+                   Interrupt   : Interrupt_ID;
-                   Static      : in Boolean;
+                   Static      : Boolean;
-                   Restoration : in Boolean := False)
+                   Restoration : Boolean := False)
               do
                  Unprotected_Exchange_Handler
                    (Old_Handler, New_Handler, Interrupt, Static, Restoration);
@@ -1026,9 +1026,9 @@ package body System.Interrupts is
            or
               accept Exchange_Handler
                  (Old_Handler : out Parameterless_Handler;
-                   New_Handler : in Parameterless_Handler;
+                   New_Handler : Parameterless_Handler;
-                   Interrupt   : in Interrupt_ID;
+                   Interrupt   : Interrupt_ID;
-                   Static      : in Boolean)
+                   Static      : Boolean)
               do
                  Unprotected_Exchange_Handler
                    (Old_Handler, New_Handler, Interrupt, Static);
@@ -1036,8 +1036,8 @@ package body System.Interrupts is
            or
               accept Detach_Handler
-                 (Interrupt   : in Interrupt_ID;
+                 (Interrupt   : Interrupt_ID;
-                  Static      : in Boolean)
+                  Static      : Boolean)
               do
                  Unprotected_Detach_Handler (Interrupt, Static);
               end Detach_Handler;

--- a/gcc/ada/s-interr.ads
+++ b/gcc/ada/s-interr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
--          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005 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- --
@@ -39,7 +39,7 @@
 --  It is made a child of System to allow visibility of various
 --  runtime system internal data and operations.
--  See System.Interrupt_Management for core interrupt/signal interfaces.
+--  See System.Interrupt_Management for core interrupt/signal interfaces
 --  These two packages are separated in order to allow
 --  System.Interrupt_Management to be used without requiring the whole
@@ -95,8 +95,7 @@ package System.Interrupts is
   function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean;
   function Current_Handler
-     (Interrupt : Interrupt_ID)
+     (Interrupt : Interrupt_ID) return Parameterless_Handler;
-      return Parameterless_Handler;
   --  Calling the following procedures with New_Handler = null
   --  and Static = true means that we want to modify the current handler
@@ -119,8 +118,7 @@ package System.Interrupts is
      Static    : Boolean := False);
   function Reference
-     (Interrupt : Interrupt_ID)
+     (Interrupt : Interrupt_ID) return System.Address;
-     return       System.Address;
   --------------------------------
   -- Interrupt Entries Services --
@@ -150,8 +148,7 @@ package System.Interrupts is
   procedure Unblock_Interrupt (Interrupt : Interrupt_ID);
   function Unblocked_By
-     (Interrupt   : Interrupt_ID)
+     (Interrupt : Interrupt_ID) return System.Tasking.Task_Id;
-      return System.Tasking.Task_Id;
   --  It returns the ID of the last Task which Unblocked this Interrupt.
   --  It returns Null_Task if no tasks have ever requested the
   --  Unblocking operation or the Interrupt is currently Blocked.
@@ -185,38 +182,36 @@ package System.Interrupts is
   --  There are two kinds of protected objects that deal with interrupts:
-   --  (1) Only Interrupt_Handler pragmas are used. We need to be able to
+   --  (1) Only Interrupt_Handler pragmas are used. We need to be able to tell
-   --  tell if an Interrupt_Handler applies to a given procedure, so
+   --  if an Interrupt_Handler applies to a given procedure, so
   --  Register_Interrupt_Handler has to be called for all the potential
-   --  handlers, it should be done by calling Register_Interrupt_Handler
+   --  handlers, it should be done by calling Register_Interrupt_Handler with
-   --  with the handler code address. On finalization, which can happen only
+   --  the handler code address. On finalization, which can happen only has
-   --  has part of library level finalization since PO with
+   --  part of library level finalization since PO with Interrupt_Handler
-   --  Interrupt_Handler pragmas can only be declared at library level,
+   --  pragmas can only be declared at library level, nothing special needs to
-   --  nothing special needs to be done since the default handlers have been
+   --  be done since the default handlers have been restored as part of task
-   --  restored as part of task completion which is done just before global
+   --  completion which is done just before global finalization.
-   --  finalization.  Dynamic_Interrupt_Protection should be used in this
+   --  Dynamic_Interrupt_Protection should be used in this case.
-   --  case.
   --  (2) Attach_Handler pragmas are used, and possibly Interrupt_Handler
-   --  pragma. We need to attach the handlers to the given interrupts when
+   --  pragma. We need to attach the handlers to the given interrupts when the
-   --  the objet is elaborated. This should be done by constructing an array
+   --  objet is elaborated. This should be done by constructing an array of
-   --  of pairs (interrupt, handler) from the pragmas and calling
+   --  pairs (interrupt, handler) from the pragmas and calling Install_Handlers
-   --  Install_Handlers with it (types to be used are New_Handler_Item and
+   --  with it (types to be used are New_Handler_Item and New_Handler_Array).
-   --  New_Handler_Array). On finalization, we need to restore the handlers
+   --  On finalization, we need to restore the handlers that were installed
-   --  that were installed before the elaboration of the PO, so we need to
+   --  before the elaboration of the PO, so we need to store these previous
-   --  store these previous handlers. This is also done by Install_Handlers,
+   --  handlers. This is also done by Install_Handlers, the room for these
-   --  the room for these informations is provided by adding a discriminant
+   --  informations is provided by adding a discriminant which is the number
-   --  which is the number of Attach_Handler pragmas and an array of this
+   --  of Attach_Handler pragmas and an array of this size in the protection
-   --  size in the protection type, Static_Interrupt_Protection.
+   --  type, Static_Interrupt_Protection.
   procedure Register_Interrupt_Handler
     (Handler_Addr : System.Address);
-   --  This routine should be called by the compiler to allow the
+   --  This routine should be called by the compiler to allow the handler be
-   --  handler be used as an Interrupt Handler. That means call this
+   --  used as an Interrupt Handler. That means call this procedure for each
-   --  procedure for each pragma Interrup_Handler providing the
+   --  pragma Interrup_Handler providing the address of the handler (not
-   --  address of the handler (not including the pointer to the
+   --  including the pointer to the actual PO, this way this routine is called
-   --  actual PO, this way this routine is called only once for
+   --  only once for each type definition of PO).
-   --  each type definition of PO).
   type Static_Handler_Index is range 0 .. Integer'Last;
   subtype Positive_Static_Handler_Index is
@@ -228,7 +223,7 @@ package System.Interrupts is
      Handler   : Parameterless_Handler;
      Static    : Boolean;
   end record;
-   --  Contains all the information needed to restore a previous handler.
+   --  Contains all the information needed to restore a previous handler
   type Previous_Handler_Array is array
     (Positive_Static_Handler_Index range <>) of Previous_Handler_Item;
@@ -237,7 +232,7 @@ package System.Interrupts is
      Interrupt : Interrupt_ID;
      Handler   : Parameterless_Handler;
   end record;
-   --  Contains all the information from an Attach_Handler pragma.
+   --  Contains all the information from an Attach_Handler pragma
   type New_Handler_Array is
     array (Positive_Static_Handler_Index range <>) of New_Handler_Item;
@@ -253,7 +248,7 @@ package System.Interrupts is
   function Has_Interrupt_Or_Attach_Handler
     (Object : access Dynamic_Interrupt_Protection) return Boolean;
-   --  Returns True.
+   --  Returns True
   --  Case (2)
@@ -267,9 +262,8 @@ package System.Interrupts is
     end record;
   function Has_Interrupt_Or_Attach_Handler
-     (Object : access Static_Interrupt_Protection)
+     (Object : access Static_Interrupt_Protection) return Boolean;
-      return   Boolean;
+   --  Returns True
-   --  Returns True.
   procedure Finalize (Object : in out Static_Interrupt_Protection);
   --  Restore previous handlers as required by C.3.1(12) then call
@@ -277,7 +271,7 @@ package System.Interrupts is
   procedure Install_Handlers
     (Object       : access Static_Interrupt_Protection;
-      New_Handlers : in New_Handler_Array);
+      New_Handlers : New_Handler_Array);
   --  Store the old handlers in Object.Previous_Handlers and install
   --  the new static handlers.

--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9603,13 +9603,15 @@ package body Sem_Ch3 is
         end if;
      end Comes_From_Generic;
+   --  Start of processing for Derived_Type_Declaration
   begin
      Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
      if Parent_Type = Any_Type
        or else Etype (Parent_Type) = Any_Type
        or else (Is_Class_Wide_Type (Parent_Type)
-                  and then Etype (Parent_Type) = T)
+                   and then Etype (Parent_Type) = T)
      then
         --  If Parent_Type is undefined or illegal, make new type into a
         --  subtype of Any_Type, and set a few attributes to prevent cascaded

--- a/gcc/ada/snames.adb
+++ b/gcc/ada/snames.adb
@@ -735,15 +735,18 @@ package body Snames is
   --    xxxDF   deep finalize routine for type xxx                 (Exp_TSS)
   --    xxxDI   deep initialize routine for type xxx               (Exp_TSS)
   --    xxxEQ   composite equality routine for record type xxx     (Exp_TSS)
+   --    xxxFA   PolyORB/DSA From_Any converter for type xxx        (Exp_TSS)
   --    xxxIP   initialization procedure for type xxx              (Exp_TSS)
-   --    xxxRA   RAs type access routine for type xxx               (Exp_TSS)
+   --    xxxRA   RAS type access routine for type xxx               (Exp_TSS)
-   --    xxxRD   RAs type dereference routine for type xxx          (Exp_TSS)
+   --    xxxRD   RAS type dereference routine for type xxx          (Exp_TSS)
   --    xxxRP   Rep to Pos conversion for enumeration type xxx     (Exp_TSS)
   --    xxxSA   array/slice assignment for controlled comp. arrays (Exp_TSS)
   --    xxxSI   stream input attribute subprogram for type xxx     (Exp_TSS)
   --    xxxSO   stream output attribute subprogram for type xxx    (Exp_TSS)
   --    xxxSR   stream read attribute subprogram for type xxx      (Exp_TSS)
   --    xxxSW   stream write attribute subprogram for type xxx     (Exp_TSS)
+   --    xxxTA   PolyORB/DSA To_Any converter for type xxx          (Exp_TSS)
+   --    xxxTC   PolyORB/DSA Typecode for type xxx                  (Exp_TSS)
   --  Implicit type names