diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2005-03-18 12:55:47 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2005-03-18 12:55:47 +0100 |
commit | fa7c4d231fb72d7a522f3894ea121177a899fdec (patch) | |
tree | 4b33a5dc68585402508fa243369778006f1ade16 /gcc | |
parent | 8095d0fa91c3cc9af26742b032159149b9f1e9d4 (diff) | |
download | gcc-fa7c4d231fb72d7a522f3894ea121177a899fdec.zip gcc-fa7c4d231fb72d7a522f3894ea121177a899fdec.tar.gz gcc-fa7c4d231fb72d7a522f3894ea121177a899fdec.tar.bz2 |
[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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/a-interr.adb | 7 | ||||
-rw-r--r-- | gcc/ada/a-interr.ads | 5 | ||||
-rw-r--r-- | gcc/ada/casing.adb | 23 | ||||
-rw-r--r-- | gcc/ada/g-expect.adb | 32 | ||||
-rw-r--r-- | gcc/ada/gnat_ugn.texi | 2 | ||||
-rw-r--r-- | gcc/ada/prj.adb | 12 | ||||
-rw-r--r-- | gcc/ada/prj.ads | 4 | ||||
-rw-r--r-- | gcc/ada/s-interr-dummy.adb | 12 | ||||
-rw-r--r-- | gcc/ada/s-interr-sigaction.adb | 37 | ||||
-rw-r--r-- | gcc/ada/s-interr-vms.adb | 78 | ||||
-rw-r--r-- | gcc/ada/s-interr-vxworks.adb | 76 | ||||
-rw-r--r-- | gcc/ada/s-interr.adb | 68 | ||||
-rw-r--r-- | gcc/ada/s-interr.ads | 76 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 4 | ||||
-rw-r--r-- | gcc/ada/snames.adb | 7 |
15 files changed, 224 insertions, 219 deletions
diff --git a/gcc/ada/a-interr.adb b/gcc/ada/a-interr.adb index 72e42a8..a603a57 100644 --- 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) - return Parameterless_Handler + (Interrupt : Interrupt_ID) 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; diff --git a/gcc/ada/a-interr.ads b/gcc/ada/a-interr.ads index 0475dee..e857069 100644 --- 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) - return Parameterless_Handler; + (Interrupt : Interrupt_ID) return Parameterless_Handler; procedure Attach_Handler (New_Handler : Parameterless_Handler; diff --git a/gcc/ada/casing.adb b/gcc/ada/casing.adb index e2f9a48..33ed338 100644 --- 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; diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index 2571a44..2eed916 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -31,12 +31,12 @@ -- -- ------------------------------------------------------------------------------ -with System; use System; -with Ada.Calendar; use Ada.Calendar; +with System; use System; +with Ada.Calendar; use Ada.Calendar; with GNAT.IO; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Regpat; use GNAT.Regpat; +with GNAT.OS_Lib; use GNAT.OS_Lib; +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) - return GNAT.OS_Lib.File_Descriptor - is + (Descriptor : Process_Descriptor) 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) - return GNAT.OS_Lib.File_Descriptor - is + (Descriptor : Process_Descriptor) 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) - return GNAT.OS_Lib.File_Descriptor - is + (Descriptor : Process_Descriptor) 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) - return Process_Id - is + (Descriptor : Process_Descriptor) 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; - Str : String; - Add_LF : Boolean := True; + (Descriptor : in out Process_Descriptor; + Str : String; + Add_LF : Boolean := True; Empty_Buffer : Boolean := False) is Full_Str : constant String := Str & ASCII.LF; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index d04028b..246c910 100644 --- 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 diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 8158de7..37237d3 100644 --- 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_Index); + Supp := In_Tree.Supp_Languages.Table (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) - return Naming_Data + function Standard_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_Index); + Supp := In_Tree.Supp_Suffixes.Table (Supp_Index); if Supp.Index = Language then return Supp.Suffix; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index a1b685e..aa58c2f 100644 --- 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) - return Naming_Data; + function Standard_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, diff --git a/gcc/ada/s-interr-dummy.adb b/gcc/ada/s-interr-dummy.adb index 0702981..01c3ba1 100644 --- 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 a stub, for systems that --- do not support interrupts (or signals). +-- This version is 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) - return Parameterless_Handler + (Interrupt : Interrupt_ID) 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; diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index 4a7610c..d8e7f9e 100644 --- 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 - -- dynamic Handler + -- Tries to overwrite a static Interrupt Handler with dynamic handle - and then (Descriptors (Interrupt).Static + and then + (Descriptors (Interrupt).Static - -- The new handler is not specified as an - -- Interrupt Handler by a pragma. + -- New handler not specified as an 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. - -- This is need so that when an Interrupt Entry task terminates - -- the binding can be cleaned. The call to unbinding must be - -- make by the task before it terminates. + -- Indicate the attachment of Interrupt Entry in ATCB. This is needed so + -- that when an Interrupt Entry task terminates the binding can be + -- cleaned up. The call to unbinding must be make by the task before it + -- 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 - -- to be aborted at the time of system shutdown. + -- Undefer abort here to allow a window for this task to be aborted + -- at the time of system shutdown. end loop; end Server_Task; diff --git a/gcc/ada/s-interr-vms.adb b/gcc/ada/s-interr-vms.adb index 3d4b7fc..01b42b6 100644 --- 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 - -- with low-level constructs. Do not change this spec without synchro- - -- nizing it. + -- WARNING: System.Tasking.Stages performs calls to this task with + -- low-level constructs. Do not change this spec without synchronizing 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 - -- since it is outside the range of allowed priorities, but the - -- compiler treats system units specially and does not apply - -- this range checking rule to system units. + -- Note: the above pragma Priority is strictly speaking improper since + -- it is outside the range of allowed priorities, but the compiler + -- treats system units specially and does not apply this range checking + -- 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 - -- it is specified through the pragma Attach_Handler. - -- Attach_Handler. Otherwise, not static) + -- information for each interrupt. A handler is a Static one if it is + -- specified through the pragma Attach_Handler. Attach_Handler. Otherwise, + -- 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. - -- Task_Id is needed to accomplish locking per Interrupt base. Also - -- is needed to decide whether to create a new Server_Task. + -- Holds the Task_Id of the Server_Task for each interrupt. Task_Id is + -- needed to accomplish locking per Interrupt base. Also is needed to + -- 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 - -- specified by the pragma Interrupt_Handler. + -- Handlers. These definitions are used to register the handlers specified + -- 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 - -- current implementation is wrong. We need a new service in - -- Interrupt_Manager to ensure atomicity. + -- ??? Since Parameterless_Handler is not Atomic, the current + -- implementation is wrong. We need a new service in Interrupt_Manager + -- 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 - -- means we want to detach the current handler regardless of the - -- previous handler's binding status (ie. do not care if it is a - -- dynamic or static handler). + -- Calling this procedure with New_Handler = null and Static = True means + -- we want to detach the current handler regardless of the previous + -- handler's binding status (ie. do not care if it is dynamic or static + -- handler). - -- This option is needed so that during the finalization of a PO, we - -- can detach handlers attached through pragma Attach_Handler. + -- This option is needed so that during the finalization of a PO, we can + -- detach handlers attached through pragma Attach_Handler. procedure Exchange_Handler (Old_Handler : out Parameterless_Handler; 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 - -- inherit the interrupt mask from the Environment Task. + -- During the elaboration of this package body we want RTS to inherit the + -- interrupt mask from the Environment Task. - -- The Environment Task should have gotten its mask from - -- the enclosing process during the RTS start up. (See - -- in s-inmaop.adb). Pass the Interrupt_Mask of the Environment - -- task to the Interrupt_Manager. + -- The Environment Task should have gotten its mask from the enclosing + -- process during the RTS start up. (See in s-inmaop.adb). Pass the + -- Interrupt_Mask of the Environment task to the Interrupt_Manager. - -- Note : At this point we know that all tasks (including - -- RTS internal servers) are masked for non-reserved signals - -- (see s-taprop.adb). Only the Interrupt_Manager will have - -- masks set up differently inheriting the original Environment - -- Task's mask. + -- Note : At this point we know that all tasks (including RTS internal + -- servers) are masked for non-reserved signals (see s-taprop.adb). Only + -- the Interrupt_Manager will have masks set up differently inheriting the + -- original Environment Task's mask. Interrupt_Manager.Initialize (IMOP.Environment_Mask); end System.Interrupts; diff --git a/gcc/ada/s-interr-vxworks.adb b/gcc/ada/s-interr-vxworks.adb index d0eee62..c9f993b 100644 --- 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 --- tasks/threads except possibly for the Interrupt_Manager task. +-- All user-handleable signals are masked at all times in all tasks/threads +-- except possibly for the Interrupt_Manager task. --- When a user task wants to have the effect of masking/unmasking an --- signal, it must call Block_Interrupt/Unblock_Interrupt, which --- will have the effect of unmasking/masking the signal in the --- Interrupt_Manager task. These comments do not apply to vectored --- hardware interrupts, which may be masked or unmasked using routined --- interfaced to the relevant VxWorks system calls. +-- When a user task wants to have the effect of masking/unmasking an signal, +-- it must call Block_Interrupt/Unblock_Interrupt, which will have the effect +-- of unmasking/masking the signal in the Interrupt_Manager task. These +-- comments do not apply to vectored hardware interrupts, which may be masked +-- or unmasked using routined interfaced to the relevant VxWorks system +-- calls. --- Once we associate a Signal_Server_Task with an signal, the task never --- goes away, and we never remove the association. On the other hand, it --- is more convenient to terminate an associated Interrupt_Server_Task --- for a vectored hardware interrupt (since we use a binary semaphore --- for synchronization with the umbrella handler). +-- Once we associate a Signal_Server_Task with an signal, the task never goes +-- away, and we never remove the association. On the other hand, it is more +-- convenient to terminate an associated Interrupt_Server_Task for a vectored +-- hardware interrupt (since we use a binary semaphore for synchronization +-- 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 --- interrupts and Interrupt_Server_Task's at any given time. That is, --- only one non-terminated Interrupt_Server_Task exists for a give --- interrupt at any time. +-- one Signal_Server_Task per signal. The same relation holds for hardware +-- interrupts and Interrupt_Server_Task's at any given time. That is, only +-- one non-terminated Interrupt_Server_Task exists for a give interrupt at +-- 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 - -- with low-level constructs. Do not change this spec without synchro- - -- nizing it. + -- WARNING: System.Tasking.Stages performs calls to this task with + -- low-level constructs. Do not change this spec without synchronizing 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; diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 6844e88..de93ca1 100644 --- 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; - Interrupt : in Interrupt_ID; - Static : in Boolean; - Restoration : in Boolean := False); + (New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean; + Restoration : Boolean := False); entry Exchange_Handler (Old_Handler : out Parameterless_Handler; - New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean); + New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean); entry Detach_Handler - (Interrupt : in Interrupt_ID; - Static : in Boolean); + (Interrupt : Interrupt_ID; + 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; - Interrupt : in Interrupt_ID; - Static : in Boolean := False) + (New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + 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 - -- current implementation is wrong. We need a new service in - -- Interrupt_Manager to ensure atomicity. + -- ??? Since Parameterless_Handler is not Atomic, the current + -- implementation is wrong. We need a new service in Interrupt_Manager + -- 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 - -- Interrupt Handler. Routines attaching and detaching Handler - -- dynamically should first consult if the Handler is rgistered. - -- A Program Error should be raised if it is not registered. + -- This routine registers the Handler as usable for Dynamic Interrupt + -- Handler. Routines attaching and detaching Handler dynamically should + -- first consult if the Handler is registered. A Program Error should + -- be raised if it is not registered. - -- The pragma Interrupt_Handler can only appear in the library - -- level PO definition and instantiation. Therefore, we do not need - -- to implement Unregistering operation. Neither we need to - -- protect the queue structure using a Lock. + -- The pragma Interrupt_Handler can only appear in the library level PO + -- definition and instantiation. Therefore, we do not need to implement + -- Unregistering operation. Neither we need to protect the queue + -- 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; - Interrupt : in Interrupt_ID; - Static : in Boolean; - Restoration : in Boolean := False) + (New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean; + 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; - Interrupt : in Interrupt_ID; - Static : in Boolean) + New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + 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; - Static : in Boolean) + (Interrupt : Interrupt_ID; + Static : Boolean) do Unprotected_Detach_Handler (Interrupt, Static); end Detach_Handler; diff --git a/gcc/ada/s-interr.ads b/gcc/ada/s-interr.ads index 2377249..94f6dd3 100644 --- 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) - return Parameterless_Handler; + (Interrupt : Interrupt_ID) 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) - return System.Address; + (Interrupt : Interrupt_ID) 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) - return System.Tasking.Task_Id; + (Interrupt : Interrupt_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 - -- tell if an Interrupt_Handler applies to a given procedure, so + -- (1) Only Interrupt_Handler pragmas are used. We need to be able to tell + -- 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 - -- with the handler code address. On finalization, which can happen only - -- has part of library level finalization since PO with - -- Interrupt_Handler pragmas can only be declared at library level, - -- nothing special needs to be done since the default handlers have been - -- restored as part of task completion which is done just before global - -- finalization. Dynamic_Interrupt_Protection should be used in this - -- case. + -- handlers, it should be done by calling Register_Interrupt_Handler with + -- the handler code address. On finalization, which can happen only has + -- part of library level finalization since PO with Interrupt_Handler + -- pragmas can only be declared at library level, nothing special needs to + -- be done since the default handlers have been restored as part of task + -- completion which is done just before global finalization. + -- Dynamic_Interrupt_Protection should be used in this case. -- (2) Attach_Handler pragmas are used, and possibly Interrupt_Handler - -- pragma. We need to attach the handlers to the given interrupts when - -- the objet is elaborated. This should be done by constructing an array - -- of pairs (interrupt, handler) from the pragmas and calling - -- Install_Handlers with it (types to be used are New_Handler_Item and - -- New_Handler_Array). On finalization, we need to restore the handlers - -- that were installed before the elaboration of the PO, so we need to - -- store these previous handlers. This is also done by Install_Handlers, - -- the room for these informations is provided by adding a discriminant - -- which is the number of Attach_Handler pragmas and an array of this - -- size in the protection type, Static_Interrupt_Protection. + -- pragma. We need to attach the handlers to the given interrupts when the + -- objet is elaborated. This should be done by constructing an array of + -- pairs (interrupt, handler) from the pragmas and calling Install_Handlers + -- with it (types to be used are New_Handler_Item and New_Handler_Array). + -- On finalization, we need to restore the handlers that were installed + -- before the elaboration of the PO, so we need to store these previous + -- handlers. This is also done by Install_Handlers, the room for these + -- informations is provided by adding a discriminant which is the number + -- of Attach_Handler pragmas and an array of this size in the protection + -- type, Static_Interrupt_Protection. procedure Register_Interrupt_Handler (Handler_Addr : System.Address); - -- This routine should be called by the compiler to allow the - -- handler be used as an Interrupt Handler. That means call this - -- procedure for each pragma Interrup_Handler providing the - -- address of the handler (not including the pointer to the - -- actual PO, this way this routine is called only once for - -- each type definition of PO). + -- This routine should be called by the compiler to allow the handler be + -- used as an Interrupt Handler. That means call this procedure for each + -- pragma Interrup_Handler providing the address of the handler (not + -- including the pointer to the actual PO, this way this routine is called + -- only once for 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) - return Boolean; - -- Returns True. + (Object : access Static_Interrupt_Protection) return Boolean; + -- 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. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e1bd1e8..609871a 100644 --- 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 diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index ee6e8bb..66f1345 100644 --- 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) - -- xxxRD RAs type dereference 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) -- 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 |