diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-03-26 07:35:19 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-03-26 07:35:19 +0000 |
| commit | 35e3878c197ab1098b7fa58ad1116b1ecb992711 (patch) | |
| tree | f4283c76a38a1de33842f56020e3fffd6f796a0e /gcc | |
| parent | ead7fc2d9d051f96787b848777f24595ba28d2e8 (diff) | |
| download | gcc-35e3878c197ab1098b7fa58ad1116b1ecb992711.tar.gz | |
2008-03-26 Robert Dewar <dewar@adacore.com>
* a-taster.adb, s-shasto.adb, s-soflin.adb, s-taasde.adb, s-taenca.adb,
a-sytaco.adb, a-sytaco.ads, a-tasatt.adb, a-taside.adb,
a-intnam-lynxos.ads, a-retide.adb, a-intnam-tru64.ads, a-intnam-aix.ads,
a-intnam-irix.ads, a-intnam-hpux.ads, a-intnam-linux.ads,
a-intnam-solaris.ads, a-caldel-vms.adb, a-intnam-vms.ads,
a-excpol-abort.adb, a-intnam-mingw.ads, s-interr.adb, s-interr.ads,
s-intman.ads, s-gloloc.adb, s-osinte-lynxos-3.ads,
s-interr-sigaction.adb, s-osinte-hpux.ads, s-osinte-solaris-posix.ads,
a-intnam-freebsd.ads, s-osinte-freebsd.ads, s-osinte-lynxos.ads,
s-taspri-lynxos.ads, s-osinte-tru64.ads, s-osinte-tru64.ads,
s-taspri-tru64.ads, s-osinte-aix.ads, s-osinte-irix.ads,
s-osinte-hpux-dce.ads, s-taprop-hpux-dce.adb, s-taspri-hpux-dce.ads,
s-osinte-linux.ads, s-osinte-dummy.ads, s-taprop-dummy.adb,
s-taspri-dummy.ads, s-interr-dummy.adb, s-osinte-solaris.ads,
s-osinte-mingw.ads, s-taprop-solaris.adb, s-taspri-solaris.ads,
s-inmaop-vms.adb, s-interr-vms.adb, s-intman-vms.ads, s-osinte-vms.ads,
s-osinte-vms.ads, s-taprop-vms.adb, s-taspri-vms.ads,
s-taspri-mingw.ads, s-interr-vxworks.adb, s-inmaop-posix.adb,
s-intman-vxworks.ads, s-osinte-vxworks.ads, s-osprim-vxworks.adb,
s-taspri-vxworks.ads, s-taspri-posix.ads, a-caldel.adb, a-calend.adb,
a-elchha.adb, a-dynpri.adb, a-except.adb, a-except.ads, a-interr.ads,
a-textio.adb, a-tigeau.ads, atree.adb, s-taprob.adb, s-taprop.ads,
s-tarest.adb, s-tarest.ads, s-tasini.adb, s-taskin.adb, s-taskin.ads,
s-tasque.adb, s-tasren.adb, s-tasren.ads, s-tassta.adb, s-tassta.ads,
s-tasuti.adb, s-tataat.adb, s-tataat.ads, s-tpoben.adb, s-tpoben.ads,
s-tpobop.adb, s-tpobop.ads, s-tposen.adb, s-tposen.ads, s-valrea.adb,
s-valuti.adb, a-intnam-darwin.ads, s-osinte-darwin.ads, s-solita.adb,
a-ztinau.ads, s-osinte-linux-hppa.ads, a-except-2005.adb,
a-except-2005.ads, a-rttiev.adb, s-osinte-vxworks6.ads, s-regexp.adb,
s-tasloc.adb: Minor reformatting.
Update comments.
Remove "used for" sections from comments.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@133546 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
106 files changed, 687 insertions, 1372 deletions
diff --git a/gcc/ada/a-caldel-vms.adb b/gcc/ada/a-caldel-vms.adb index b58e17e39e6..ed52533d081 100644 --- a/gcc/ada/a-caldel-vms.adb +++ b/gcc/ada/a-caldel-vms.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2005, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,10 +35,7 @@ -- This is the Alpha/VMS version with System.OS_Primitives; --- Used for Max_Sensible_Delay - with System.Soft_Links; --- Used for Timed_Delay package body Ada.Calendar.Delays is diff --git a/gcc/ada/a-caldel.adb b/gcc/ada/a-caldel.adb index d2b701e815f..3410b6135fe 100644 --- a/gcc/ada/a-caldel.adb +++ b/gcc/ada/a-caldel.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2006, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -33,17 +33,9 @@ ------------------------------------------------------------------------------ with System.OS_Primitives; --- Used for Delay_Modes --- Max_Sensible_Delay - with System.Soft_Links; --- Used for Timed_Delay - with System.Traces; --- Used for Send_Trace_Info - with System.Parameters; --- used for Runtime_Traces package body Ada.Calendar.Delays is diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index b897fa762ac..1fe977d68a4 100644 --- a/gcc/ada/a-calend.adb +++ b/gcc/ada/a-calend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -34,7 +34,6 @@ with Ada.Unchecked_Conversion; with System.OS_Primitives; --- used for Clock package body Ada.Calendar is diff --git a/gcc/ada/a-dynpri.adb b/gcc/ada/a-dynpri.adb index 982c17f99b7..5950cf82f90 100644 --- a/gcc/ada/a-dynpri.adb +++ b/gcc/ada/a-dynpri.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,21 +32,9 @@ ------------------------------------------------------------------------------ with System.Task_Primitives.Operations; --- used for Write_Lock --- Unlock --- Set_Priority --- Wakeup --- Self - with System.Tasking; --- used for Task_Id - with System.Parameters; --- used for Single_Lock - with System.Soft_Links; --- use for Abort_Defer --- Abort_Undefer with Ada.Unchecked_Conversion; diff --git a/gcc/ada/a-elchha.adb b/gcc/ada/a-elchha.adb index 41ca1f57b41..fc4f9621b17 100644 --- a/gcc/ada/a-elchha.adb +++ b/gcc/ada/a-elchha.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2008, 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- -- @@ -38,11 +38,7 @@ pragma Compiler_Unit; pragma Warnings (On); with System.Standard_Library; use System.Standard_Library; --- Used for Adafinal - with System.Soft_Links; --- Used for Task_Termination_Handler --- Task_Termination_NT procedure Ada.Exceptions.Last_Chance_Handler (Except : Exception_Occurrence) diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 0994d201402..402a04cbe85 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -31,16 +31,14 @@ -- -- ------------------------------------------------------------------------------ --- This version is used for all Ada 2005 builds. It differs from a-except.ads --- only with respect to the addition of Wide_[Wide]Exception_Name functions. +-- This version of Ada.Exceptions fully supports both Ada 95 and Ada 2005. +-- It is used in all situations except for the build of the compiler and +-- other basic tools. For these latter builds, we use an Ada 95-only version. -- The reason for this splitting off of a separate version is that bootstrap -- compilers often will be used that do not support Ada 2005 features, and -- Ada.Exceptions is part of the compiler sources. --- The base version of this unit Ada.Exceptions omits the Wide version of --- Exception_Name and is used to build the compiler and other basic tools. - pragma Style_Checks (All_Checks); -- No subprogram ordering check, due to logical grouping diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads index 62135090d99..6dae91ff467 100644 --- a/gcc/ada/a-except-2005.ads +++ b/gcc/ada/a-except-2005.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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 -- @@ -35,18 +35,14 @@ -- -- ------------------------------------------------------------------------------ --- This version is used for all Ada 2005 builds. It differs from a-except.ads --- only with respect to the addition of Wide_[Wide]Exception_Name functions. --- The additional entities are marked with pragma Ada_05, so this extended --- unit is also perfectly suitable for use in Ada 95 or Ada 83 mode. +-- This version of Ada.Exceptions fully supports both Ada 95 and Ada 2005. +-- It is used in all situations except for the build of the compiler and +-- other basic tools. For these latter builds, we use an Ada 95-only version. -- The reason for this splitting off of a separate version is that bootstrap -- compilers often will be used that do not support Ada 2005 features, and -- Ada.Exceptions is part of the compiler sources. --- The base version of this unit Ada.Exceptions omits the Wide version of --- Exception_Name and is used to build the compiler and other basic tools. - pragma Polling (Off); -- We must turn polling off for this unit, because otherwise we get -- elaboration circularities with ourself. diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index 60f59952770..a07bf294203 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- diff --git a/gcc/ada/a-except.ads b/gcc/ada/a-except.ads index f01d1769029..a97ccb44032 100644 --- a/gcc/ada/a-except.ads +++ b/gcc/ada/a-except.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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 -- diff --git a/gcc/ada/a-excpol-abort.adb b/gcc/ada/a-excpol-abort.adb index db04ec57e4d..dd5635bb859 100644 --- a/gcc/ada/a-excpol-abort.adb +++ b/gcc/ada/a-excpol-abort.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -45,7 +45,6 @@ pragma Warnings (Off); -- It is safe in the context of the run-time to violate the rules! with System.Soft_Links; --- used for Check_Abort_Status pragma Warnings (On); diff --git a/gcc/ada/a-interr.ads b/gcc/ada/a-interr.ads index 8c9c7212b6d..8ccbd886a7d 100644 --- a/gcc/ada/a-interr.ads +++ b/gcc/ada/a-interr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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 -- @@ -36,7 +36,6 @@ ------------------------------------------------------------------------------ with System.Interrupts; --- used for Ada_Interrupt_ID package Ada.Interrupts is diff --git a/gcc/ada/a-intnam-aix.ads b/gcc/ada/a-intnam-aix.ads index 12287066f61..cf01fc0a796 100644 --- a/gcc/ada/a-intnam-aix.ads +++ b/gcc/ada/a-intnam-aix.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -51,13 +51,12 @@ -- supported by the local system. with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is -- Beware that the mapping of names to signals may be many-to-one. There - -- may be aliases. Also, for all signal names that are not supported on the - -- current system the value of the corresponding constant will be zero. + -- may be aliases. Also, for all signal names that are not supported on + -- the current system the value of the corresponding constant will be zero. SIGHUP : constant Interrupt_ID := System.OS_Interface.SIGHUP; -- hangup diff --git a/gcc/ada/a-intnam-darwin.ads b/gcc/ada/a-intnam-darwin.ads index 23d12f1de50..fbbb185835b 100644 --- a/gcc/ada/a-intnam-darwin.ads +++ b/gcc/ada/a-intnam-darwin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -45,7 +45,6 @@ -- supported by the local system. with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is @@ -53,100 +52,100 @@ package Ada.Interrupts.Names is -- may be aliases. Also, for all signal names that are not supported on the -- current system the value of the corresponding constant will be zero. - SIGHUP : constant Interrupt_ID := + SIGHUP : constant Interrupt_ID := System.OS_Interface.SIGHUP; -- hangup - SIGINT : constant Interrupt_ID := + SIGINT : constant Interrupt_ID := System.OS_Interface.SIGINT; -- interrupt (rubout) - SIGQUIT : constant Interrupt_ID := + SIGQUIT : constant Interrupt_ID := System.OS_Interface.SIGQUIT; -- quit (ASCD FS) - SIGILL : constant Interrupt_ID := + SIGILL : constant Interrupt_ID := System.OS_Interface.SIGILL; -- illegal instruction (not reset) - SIGTRAP : constant Interrupt_ID := + SIGTRAP : constant Interrupt_ID := System.OS_Interface.SIGTRAP; -- trace trap (not reset) - SIGIOT : constant Interrupt_ID := + SIGIOT : constant Interrupt_ID := System.OS_Interface.SIGIOT; -- IOT instruction - SIGABRT : constant Interrupt_ID := -- used by abort, + SIGABRT : constant Interrupt_ID := -- used by abort, System.OS_Interface.SIGABRT; -- replace SIGIOT in the future - SIGEMT : constant Interrupt_ID := + SIGEMT : constant Interrupt_ID := System.OS_Interface.SIGEMT; -- EMT instruction - SIGFPE : constant Interrupt_ID := + SIGFPE : constant Interrupt_ID := System.OS_Interface.SIGFPE; -- floating point exception - SIGKILL : constant Interrupt_ID := + SIGKILL : constant Interrupt_ID := System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) - SIGBUS : constant Interrupt_ID := + SIGBUS : constant Interrupt_ID := System.OS_Interface.SIGBUS; -- bus error - SIGSEGV : constant Interrupt_ID := + SIGSEGV : constant Interrupt_ID := System.OS_Interface.SIGSEGV; -- segmentation violation - SIGSYS : constant Interrupt_ID := + SIGSYS : constant Interrupt_ID := System.OS_Interface.SIGSYS; -- bad argument to system call - SIGPIPE : constant Interrupt_ID := -- write on a pipe with + SIGPIPE : constant Interrupt_ID := -- write on a pipe with System.OS_Interface.SIGPIPE; -- no one to read it - SIGALRM : constant Interrupt_ID := + SIGALRM : constant Interrupt_ID := System.OS_Interface.SIGALRM; -- alarm clock - SIGTERM : constant Interrupt_ID := + SIGTERM : constant Interrupt_ID := System.OS_Interface.SIGTERM; -- software termination signal from kill - SIGURG : constant Interrupt_ID := + SIGURG : constant Interrupt_ID := System.OS_Interface.SIGURG; -- urgent condition on IO channel - SIGSTOP : constant Interrupt_ID := + SIGSTOP : constant Interrupt_ID := System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) - SIGTSTP : constant Interrupt_ID := + SIGTSTP : constant Interrupt_ID := System.OS_Interface.SIGTSTP; -- user stop requested from tty - SIGCONT : constant Interrupt_ID := + SIGCONT : constant Interrupt_ID := System.OS_Interface.SIGCONT; -- stopped process has been continued - SIGCHLD : constant Interrupt_ID := + SIGCHLD : constant Interrupt_ID := System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD - SIGTTIN : constant Interrupt_ID := + SIGTTIN : constant Interrupt_ID := System.OS_Interface.SIGTTIN; -- background tty read attempted - SIGTTOU : constant Interrupt_ID := + SIGTTOU : constant Interrupt_ID := System.OS_Interface.SIGTTOU; -- background tty write attempted - SIGIO : constant Interrupt_ID := -- input/output possible, + SIGIO : constant Interrupt_ID := -- input/output possible, System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) - SIGXCPU : constant Interrupt_ID := + SIGXCPU : constant Interrupt_ID := System.OS_Interface.SIGXCPU; -- CPU time limit exceeded - SIGXFSZ : constant Interrupt_ID := + SIGXFSZ : constant Interrupt_ID := System.OS_Interface.SIGXFSZ; -- filesize limit exceeded SIGVTALRM : constant Interrupt_ID := System.OS_Interface.SIGVTALRM; -- virtual timer expired - SIGPROF : constant Interrupt_ID := + SIGPROF : constant Interrupt_ID := System.OS_Interface.SIGPROF; -- profiling timer expired - SIGWINCH : constant Interrupt_ID := + SIGWINCH : constant Interrupt_ID := System.OS_Interface.SIGWINCH; -- window size change - SIGINFO : constant Interrupt_ID := + SIGINFO : constant Interrupt_ID := System.OS_Interface.SIGINFO; -- information request - SIGUSR1 : constant Interrupt_ID := + SIGUSR1 : constant Interrupt_ID := System.OS_Interface.SIGUSR1; -- user defined signal 1 - SIGUSR2 : constant Interrupt_ID := + SIGUSR2 : constant Interrupt_ID := System.OS_Interface.SIGUSR2; -- user defined signal 2 end Ada.Interrupts.Names; diff --git a/gcc/ada/a-intnam-freebsd.ads b/gcc/ada/a-intnam-freebsd.ads index 329b0f6508f..fdae2170510 100644 --- a/gcc/ada/a-intnam-freebsd.ads +++ b/gcc/ada/a-intnam-freebsd.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -34,10 +34,13 @@ -- This is the FreeBSD THREADS version of this package with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is + -- Beware that the mapping of names to signals may be many-to-one. There + -- may be aliases. Also, for all signal names that are not supported on + -- the current system the value of the corresponding constant will be zero. + SIGHUP : constant Interrupt_ID := System.OS_Interface.SIGHUP; -- hangup @@ -128,9 +131,4 @@ package Ada.Interrupts.Names is SIGUSR2 : constant Interrupt_ID := System.OS_Interface.SIGUSR2; -- user defined signal 2 - -- Beware that the mapping of names to signals may be - -- many-to-one. There may be aliases. Also, for all - -- signal names that are not supported on the current system - -- the value of the corresponding constant will be zero. - end Ada.Interrupts.Names; diff --git a/gcc/ada/a-intnam-hpux.ads b/gcc/ada/a-intnam-hpux.ads index 51eee895a9e..2f7b91963f8 100644 --- a/gcc/ada/a-intnam-hpux.ads +++ b/gcc/ada/a-intnam-hpux.ads @@ -6,8 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2005, AdaCore -- +-- Copyright (C) 1991-2008, 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- -- @@ -47,14 +46,12 @@ -- supported by the local system. with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is - -- Beware that the mapping of names to signals may be - -- many-to-one. There may be aliases. Also, for all - -- signal names that are not supported on the current system - -- the value of the corresponding constant will be zero. + -- Beware that the mapping of names to signals may be many-to-one. There + -- may be aliases. Also, for all signal names that are not supported on + -- the current system the value of the corresponding constant will be zero. SIGHUP : constant Interrupt_ID := System.OS_Interface.SIGHUP; -- hangup diff --git a/gcc/ada/a-intnam-irix.ads b/gcc/ada/a-intnam-irix.ads index 43aed478823..0e7c55919f8 100644 --- a/gcc/ada/a-intnam-irix.ads +++ b/gcc/ada/a-intnam-irix.ads @@ -6,8 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2005, AdaCore -- +-- Copyright (C) 1991-2008, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU Library General Public License as published by the -- @@ -53,14 +52,12 @@ -- supported by the local system. with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is - -- Beware that the mapping of names to signals may be - -- many-to-one. There may be aliases. Also, for all - -- signal names that are not supported on the current system - -- the value of the corresponding constant will be zero. + -- Beware that the mapping of names to signals may be many-to-one. There + -- may be aliases. Also, for all signal names that are not supported on + -- the current system the value of the corresponding constant will be zero. SIGHUP : constant Interrupt_ID := System.OS_Interface.SIGHUP; -- hangup diff --git a/gcc/ada/a-intnam-linux.ads b/gcc/ada/a-intnam-linux.ads index 70fb471b084..5425eb32ae3 100644 --- a/gcc/ada/a-intnam-linux.ads +++ b/gcc/ada/a-intnam-linux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -51,7 +51,6 @@ -- supported by the local system. with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is diff --git a/gcc/ada/a-intnam-lynxos.ads b/gcc/ada/a-intnam-lynxos.ads index 850eb2af033..0f4196261c7 100644 --- a/gcc/ada/a-intnam-lynxos.ads +++ b/gcc/ada/a-intnam-lynxos.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -43,7 +43,6 @@ -- SIGINT: made available for Ada handler with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is diff --git a/gcc/ada/a-intnam-mingw.ads b/gcc/ada/a-intnam-mingw.ads index a8c5e4ee11a..d7a2de73f3a 100644 --- a/gcc/ada/a-intnam-mingw.ads +++ b/gcc/ada/a-intnam-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2008, 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- -- @@ -37,7 +37,6 @@ -- by the local system. with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is @@ -45,22 +44,22 @@ package Ada.Interrupts.Names is -- may be aliases. Also, for all signal names that are not supported on the -- current system the value of the corresponding constant will be zero. - SIGINT : constant Interrupt_ID := - System.OS_Interface.SIGINT; -- interrupt (rubout) + SIGINT : constant Interrupt_ID := -- interrupt (rubout) + System.OS_Interface.SIGINT; - SIGILL : constant Interrupt_ID := - System.OS_Interface.SIGILL; -- illegal instruction (not reset) + SIGILL : constant Interrupt_ID := -- illegal instruction (not reset) + System.OS_Interface.SIGILL; - SIGABRT : constant Interrupt_ID := -- used by abort, - System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + SIGABRT : constant Interrupt_ID := -- used by abort (use SIGIOT in future) + System.OS_Interface.SIGABRT; - SIGFPE : constant Interrupt_ID := - System.OS_Interface.SIGFPE; -- floating point exception + SIGFPE : constant Interrupt_ID := -- floating point exception + System.OS_Interface.SIGFPE; - SIGSEGV : constant Interrupt_ID := - System.OS_Interface.SIGSEGV; -- segmentation violation + SIGSEGV : constant Interrupt_ID := -- segmentation violation + System.OS_Interface.SIGSEGV; - SIGTERM : constant Interrupt_ID := - System.OS_Interface.SIGTERM; -- software termination signal from kill + SIGTERM : constant Interrupt_ID := -- software termination signal from kill + System.OS_Interface.SIGTERM; end Ada.Interrupts.Names; diff --git a/gcc/ada/a-intnam-solaris.ads b/gcc/ada/a-intnam-solaris.ads index 6842d68f900..f14f7624f27 100644 --- a/gcc/ada/a-intnam-solaris.ads +++ b/gcc/ada/a-intnam-solaris.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -48,7 +48,6 @@ -- SIGINT: made available for Ada handlers with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is diff --git a/gcc/ada/a-intnam-tru64.ads b/gcc/ada/a-intnam-tru64.ads index 8b6a838c101..ec7c9078f5d 100644 --- a/gcc/ada/a-intnam-tru64.ads +++ b/gcc/ada/a-intnam-tru64.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -43,7 +43,6 @@ -- SIGINT: made available for Ada handler with System.OS_Interface; --- used for names of interrupts package Ada.Interrupts.Names is diff --git a/gcc/ada/a-intnam-vms.ads b/gcc/ada/a-intnam-vms.ads index 3b745d17ccb..8cfe0ba63ae 100644 --- a/gcc/ada/a-intnam-vms.ads +++ b/gcc/ada/a-intnam-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -37,6 +37,7 @@ -- supported by the local system. with System.OS_Interface; + package Ada.Interrupts.Names is package OS renames System.OS_Interface; diff --git a/gcc/ada/a-retide.adb b/gcc/ada/a-retide.adb index f6ffe7e3d71..42d2d173d53 100644 --- a/gcc/ada/a-retide.adb +++ b/gcc/ada/a-retide.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,15 +32,9 @@ ------------------------------------------------------------------------------ with Ada.Exceptions; --- Used for Raise_Exception with System.Tasking; --- Used for Task_Id --- Initialize - with System.Task_Primitives.Operations; --- Used for Timed_Delay --- Self package body Ada.Real_Time.Delays is diff --git a/gcc/ada/a-rttiev.adb b/gcc/ada/a-rttiev.adb index f8cd699497a..7031dfbc7c3 100644 --- a/gcc/ada/a-rttiev.adb +++ b/gcc/ada/a-rttiev.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2005-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-2008, 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- -- @@ -34,7 +34,6 @@ with System.Task_Primitives.Operations; with System.Tasking.Utilities; with System.Soft_Links; --- used for Abort_Defer/Undefer with Ada.Containers.Doubly_Linked_Lists; pragma Elaborate_All (Ada.Containers.Doubly_Linked_Lists); @@ -46,7 +45,6 @@ pragma Elaborate_All (Ada.Containers.Doubly_Linked_Lists); package body Ada.Real_Time.Timing_Events is use System.Task_Primitives.Operations; - -- for Write_Lock and Unlock package SSL renames System.Soft_Links; diff --git a/gcc/ada/a-sytaco.adb b/gcc/ada/a-sytaco.adb index 3d0aaaa8c3b..cf4d115cc14 100644 --- a/gcc/ada/a-sytaco.adb +++ b/gcc/ada/a-sytaco.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -31,20 +31,10 @@ -- -- ------------------------------------------------------------------------------ -with System.Tasking; --- Used for Detect_Blocking --- Self - with Ada.Exceptions; --- Used for Raise_Exception +with System.Tasking; with System.Task_Primitives.Operations; --- Used for Initialize --- Finalize --- Current_State --- Set_False --- Set_True --- Suspend_Until_True package body Ada.Synchronous_Task_Control is diff --git a/gcc/ada/a-sytaco.ads b/gcc/ada/a-sytaco.ads index 96480cf26e8..db102f679b3 100644 --- a/gcc/ada/a-sytaco.ads +++ b/gcc/ada/a-sytaco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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 -- @@ -36,10 +36,8 @@ ------------------------------------------------------------------------------ with System.Task_Primitives; --- Used for Suspension_Object with Ada.Finalization; --- Used for Limited_Controlled package Ada.Synchronous_Task_Control is pragma Preelaborate_05; diff --git a/gcc/ada/a-tasatt.adb b/gcc/ada/a-tasatt.adb index cc6977fd8c0..0140df956d4 100644 --- a/gcc/ada/a-tasatt.adb +++ b/gcc/ada/a-tasatt.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -222,39 +222,13 @@ -- instantiated from within a local context. with System.Error_Reporting; --- Used for Shutdown; - with System.Storage_Elements; --- Used for Integer_Address - with System.Task_Primitives.Operations; --- Used for Write_Lock --- Unlock --- Lock/Unlock_RTS - with System.Tasking; --- Used for Access_Address --- Task_Id --- Direct_Index_Vector --- Direct_Index - with System.Tasking.Initialization; --- Used for Defer_Abort --- Undefer_Abort --- Initialize_Attributes_Link --- Finalize_Attributes_Link - with System.Tasking.Task_Attributes; --- Used for Access_Node --- Access_Dummy_Wrapper --- Deallocator --- Instance --- Node --- Access_Instance with Ada.Exceptions; --- Used for Raise_Exception - with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; diff --git a/gcc/ada/a-taside.adb b/gcc/ada/a-taside.adb index 005d9619387..e9431d16499 100644 --- a/gcc/ada/a-taside.adb +++ b/gcc/ada/a-taside.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -43,7 +43,6 @@ pragma Warnings (Off); -- It is safe in the context of the run-time to violate the rules! with System.Tasking.Utilities; --- Used for Abort_Tasks pragma Warnings (On); diff --git a/gcc/ada/a-taster.adb b/gcc/ada/a-taster.adb index aa06c95cae8..1a1e6492575 100644 --- a/gcc/ada/a-taster.adb +++ b/gcc/ada/a-taster.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2005-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-2008, 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- -- @@ -32,21 +32,9 @@ ------------------------------------------------------------------------------ with System.Tasking; --- used for Task_Id - with System.Task_Primitives.Operations; --- used for Self --- Write_Lock --- Unlock --- Lock_RTS --- Unlock_RTS - with System.Parameters; --- used for Single_Lock - with System.Soft_Links; --- use for Abort_Defer --- Abort_Undefer with Ada.Unchecked_Conversion; diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb index 3711ab05b38..050e71d500c 100644 --- a/gcc/ada/a-textio.adb +++ b/gcc/ada/a-textio.adb @@ -1037,7 +1037,7 @@ package body Ada.Text_IO is Item := ASCII.NUL; -- If we are before an upper half character just return it (this can - -- happen if there are two calls to Look_Ahead in a row. + -- happen if there are two calls to Look_Ahead in a row). elsif File.Before_Upper_Half_Character then End_Of_Line := False; @@ -2253,7 +2253,7 @@ begin Standard_In.Is_Text_File := True; Standard_In.Access_Method := 'T'; Standard_In.Self := Standard_In; - Standard_In.WC_Method := Default_WCEM; + Standard_In.WC_Method := Default_WCEM; Standard_Out.Stream := stdout; Standard_Out.Name := Out_Name'Access; diff --git a/gcc/ada/a-tigeau.ads b/gcc/ada/a-tigeau.ads index d0443739142..16299b03b7f 100644 --- a/gcc/ada/a-tigeau.ads +++ b/gcc/ada/a-tigeau.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -178,7 +178,7 @@ private package Ada.Text_IO.Generic_Aux is procedure String_Skip (Str : String; Ptr : out Integer); -- Used in the Get from string procedures to skip leading blanks in the -- string. Ptr is set to the index of the first non-blank. If the string - -- is all blanks, then the excption End_Error is raised, Note that blank + -- is all blanks, then the exception End_Error is raised, Note that blank -- is defined as a space or horizontal tab (RM A.10.6(5)). procedure Ungetc (ch : Integer; File : File_Type); diff --git a/gcc/ada/a-ztinau.ads b/gcc/ada/a-ztinau.ads index b37a9d1a7a8..71454eb3b90 100644 --- a/gcc/ada/a-ztinau.ads +++ b/gcc/ada/a-ztinau.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,10 +32,10 @@ ------------------------------------------------------------------------------ -- This package contains the routines for Ada.Wide_Wide_Text_IO.Integer_IO --- that are shared among separate instantiations of this package. The --- routines in this package are identical semantically to those in Integer_IO --- itself, except that the generic parameter Num has been replaced by Integer --- or Long_Long_Integer, and the default parameters have been removed because +-- that are shared among separate instantiations of this package. The routines +-- in this package are identical semantically to those in Integer_IO itself, +-- except that the generic parameter Num has been replaced by Integer or +-- Long_Long_Integer, and the default parameters have been removed because -- they are supplied explicitly by the calls from within the generic template. private package Ada.Wide_Wide_Text_IO.Integer_Aux is diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 414fd62d734..2f504ba7a9e 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -2738,12 +2738,13 @@ package body Atree is if Field2 (Cur_Node) not in Node_Range then return Traverse_Field (Cur_Node, Field2 (Cur_Node), 2); - elsif Is_Syntactic_Field (Nkind (Cur_Node), 2) and then - Field2 (Cur_Node) /= Empty_List_Or_Node + + elsif Is_Syntactic_Field (Nkind (Cur_Node), 2) + and then Field2 (Cur_Node) /= Empty_List_Or_Node then - -- Here is the tail recursion step, we reset Cur_Node and jump - -- back to the start of the procedure, which has the same - -- semantic effect as a call. + -- Here is the tail recursion step, we reset Cur_Node and jump back + -- to the start of the procedure, which has the same semantic effect + -- as a call. Cur_Node := Node_Id (Field2 (Cur_Node)); goto Tail_Recurse; diff --git a/gcc/ada/s-gloloc.adb b/gcc/ada/s-gloloc.adb index 197b4a9abfc..2ab69089426 100644 --- a/gcc/ada/s-gloloc.adb +++ b/gcc/ada/s-gloloc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2008, 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- -- @@ -32,7 +32,6 @@ ------------------------------------------------------------------------------ with System.Soft_Links; --- used for Lock_Task, Unlock_Task package body System.Global_Locks is diff --git a/gcc/ada/s-inmaop-posix.adb b/gcc/ada/s-inmaop-posix.adb index 2251c23d3c5..3a10e73bc51 100644 --- a/gcc/ada/s-inmaop-posix.adb +++ b/gcc/ada/s-inmaop-posix.adb @@ -2,13 +2,12 @@ -- -- -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T . -- --- O P E R A T I O N S -- +-- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS -- -- -- -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -33,20 +32,14 @@ -- -- ------------------------------------------------------------------------------ --- This is a POSIX-like version of this package. --- Note: this file can only be used for POSIX compliant systems. +-- This is a POSIX-like version of this package + +-- Note: this file can only be used for POSIX compliant systems with Interfaces.C; --- used for int --- size_t --- unsigned with System.OS_Interface; --- used for various type, constant, and operations - with System.Storage_Elements; --- used for To_Address --- Integer_Address package body System.Interrupt_Management.Operations is diff --git a/gcc/ada/s-inmaop-vms.adb b/gcc/ada/s-inmaop-vms.adb index 3c04bb0e074..34eaf09547d 100644 --- a/gcc/ada/s-inmaop-vms.adb +++ b/gcc/ada/s-inmaop-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -34,19 +34,11 @@ -- This is a OpenVMS/Alpha version of this package with System.OS_Interface; --- used for various type, constant, and operations - with System.Aux_DEC; --- used for Short_Address - with System.Parameters; - with System.Tasking; - with System.Tasking.Initialization; - with System.Task_Primitives.Operations; - with System.Task_Primitives.Operations.DEC; with Ada.Unchecked_Conversion; diff --git a/gcc/ada/s-interr-dummy.adb b/gcc/ada/s-interr-dummy.adb index c0876b8ee58..075c8b5755c 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-2005, AdaCore -- +-- Copyright (C) 1995-2007, 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- -- @@ -34,8 +34,6 @@ -- This version is for systems that do not support interrupts (or signals) -with Ada.Exceptions; - package body System.Interrupts is pragma Warnings (Off); -- kill warnings on unreferenced formals @@ -293,9 +291,7 @@ package body System.Interrupts is procedure Unimplemented is begin - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "interrupts/signals not implemented"); - raise Program_Error; + raise Program_Error with "interrupts/signals not implemented"; end Unimplemented; end System.Interrupts; diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb index 38428e5d7d6..a63b35aaaa3 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-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2008, 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- -- @@ -34,47 +34,22 @@ -- This is the IRIX & NT version of this package with Ada.Task_Identification; --- used for Task_Id +with Ada.Unchecked_Conversion; -with Ada.Exceptions; --- used for Raise_Exception +with Interfaces.C; with System.Storage_Elements; --- used for To_Address --- To_Integer - with System.Task_Primitives.Operations; --- used for Self --- Sleep --- Wakeup --- Write_Lock --- Unlock - with System.Tasking.Utilities; --- used for Make_Independent - with System.Tasking.Rendezvous; --- used for Call_Simple - with System.Tasking.Initialization; --- used for Defer_Abort --- Undefer_Abort - with System.Interrupt_Management; - with System.Parameters; --- used for Single_Lock - -with Interfaces.C; --- used for int - -with Ada.Unchecked_Conversion; package body System.Interrupts is use Parameters; use Tasking; - use Ada.Exceptions; use System.OS_Interface; use Interfaces.C; @@ -183,8 +158,8 @@ package body System.Interrupts is function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Descriptors (Interrupt).T /= Null_Task; @@ -197,11 +172,11 @@ package body System.Interrupts is function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; + else + return Descriptors (Interrupt).Kind /= Unknown; end if; - - return Descriptors (Interrupt).Kind /= Unknown; end Is_Handler_Attached; ---------------- @@ -370,9 +345,9 @@ package body System.Interrupts is or else not Is_Registered (New_Handler)) then - Raise_Exception (Program_Error'Identity, + raise Program_Error with "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"); + "dynamic Handler"; end if; if Handlers (Interrupt) = null then @@ -420,12 +395,12 @@ package body System.Interrupts is -- In case we have an Interrupt Entry already installed. -- raise a program error. (propagate it to the caller). - Raise_Exception (Program_Error'Identity, - "An interrupt is already installed"); - end if; + raise Program_Error with "An interrupt is already installed"; - Old_Handler := Current_Handler (Interrupt); - Attach_Handler (New_Handler, Interrupt, Static); + else + Old_Handler := Current_Handler (Interrupt); + Attach_Handler (New_Handler, Interrupt, Static); + end if; end Exchange_Handler; -------------------- @@ -442,13 +417,12 @@ package body System.Interrupts is end if; if Descriptors (Interrupt).Kind = Task_Entry then - Raise_Exception (Program_Error'Identity, - "Trying to detach an Interrupt Entry"); + raise Program_Error with "Trying to detach an Interrupt Entry"; end if; if not Static and then Descriptors (Interrupt).Static then - Raise_Exception (Program_Error'Identity, - "Trying to detach a static Interrupt Handler"); + raise Program_Error with + "Trying to detach a static Interrupt Handler"; end if; Descriptors (Interrupt) := @@ -548,8 +522,8 @@ package body System.Interrupts is end if; if Descriptors (Interrupt).Kind /= Unknown then - Raise_Exception (Program_Error'Identity, - "A binding for this interrupt is already present"); + raise Program_Error with + "A binding for this interrupt is already present"; end if; if Handlers (Interrupt) = null then diff --git a/gcc/ada/s-interr-vms.adb b/gcc/ada/s-interr-vms.adb index 29c0e7f9b65..3a7124025c2 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-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -49,77 +49,29 @@ -- rendezvous. with Ada.Task_Identification; --- used for Task_Id type - -with Ada.Exceptions; --- used for Raise_Exception +with Ada.Unchecked_Conversion; with System.Task_Primitives; --- used for RTS_Lock --- Self - with System.Interrupt_Management; --- used for Reserve --- Interrupt_ID --- Interrupt_Mask --- Abort_Task_Interrupt with System.Interrupt_Management.Operations; --- used for Thread_Block_Interrupt --- Thread_Unblock_Interrupt --- Install_Default_Action --- Install_Ignore_Action --- Copy_Interrupt_Mask --- Set_Interrupt_Mask --- Empty_Interrupt_Mask --- Fill_Interrupt_Mask --- Add_To_Interrupt_Mask --- Delete_From_Interrupt_Mask --- Interrupt_Wait --- Interrupt_Self_Process --- Get_Interrupt_Mask --- Set_Interrupt_Mask --- IS_Member --- Environment_Mask pragma Elaborate_All (System.Interrupt_Management.Operations); with System.Task_Primitives.Operations; --- used for Write_Lock --- Unlock --- Abort --- Wakeup_Task --- Sleep --- Initialize_Lock - with System.Task_Primitives.Interrupt_Operations; --- used for Set_Interrupt_ID - with System.Storage_Elements; --- used for To_Address --- To_Integer --- Integer_Address - with System.Tasking.Utilities; --- used for Make_Independent with System.Tasking.Rendezvous; --- used for Call_Simple pragma Elaborate_All (System.Tasking.Rendezvous); with System.Tasking.Initialization; --- used for Defer_Abort --- Undefer_Abort - with System.Parameters; --- used for Single_Lock - -with Ada.Unchecked_Conversion; package body System.Interrupts is use Tasking; use System.Parameters; - use Ada.Exceptions; package POP renames System.Task_Primitives.Operations; package PIO renames System.Task_Primitives.Interrupt_Operations; @@ -345,8 +297,8 @@ package body System.Interrupts is function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Entry (Interrupt).T /= Null_Task; @@ -359,8 +311,8 @@ package body System.Interrupts is function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Handler (Interrupt).H /= null; @@ -373,8 +325,8 @@ package body System.Interrupts is function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Blocked (Interrupt); @@ -387,8 +339,8 @@ package body System.Interrupts is function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Ignored (Interrupt); @@ -403,8 +355,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; -- ??? Since Parameterless_Handler is not Atomic, the current @@ -432,8 +384,8 @@ package body System.Interrupts is Static : Boolean := False) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static); @@ -460,8 +412,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Exchange_Handler @@ -486,8 +438,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Detach_Handler (Interrupt, Static); @@ -500,8 +452,8 @@ package body System.Interrupts is function Reference (Interrupt : Interrupt_ID) return System.Address is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Storage_Elements.To_Address @@ -526,8 +478,8 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt); @@ -550,8 +502,8 @@ package body System.Interrupts is procedure Block_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Block_Interrupt (Interrupt); @@ -564,8 +516,8 @@ package body System.Interrupts is procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Unblock_Interrupt (Interrupt); @@ -579,8 +531,8 @@ package body System.Interrupts is (Interrupt : Interrupt_ID) return System.Tasking.Task_Id is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Last_Unblocker (Interrupt); @@ -593,8 +545,8 @@ package body System.Interrupts is procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Ignore_Interrupt (Interrupt); @@ -607,8 +559,8 @@ package body System.Interrupts is procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Unignore_Interrupt (Interrupt); @@ -648,21 +600,21 @@ package body System.Interrupts is is begin if User_Entry (Interrupt).T /= Null_Task then + -- In case we have an Interrupt Entry already installed. -- raise a program error. (propagate it to the caller). - Raise_Exception (Program_Error'Identity, - "An interrupt is already installed"); + raise Program_Error with "An interrupt is already installed"; end if; - -- Note : A null handler with Static = True will - -- pass the following check. That is the case when we want to - -- Detach a handler regardless of the Static status - -- of the current_Handler. - -- We don't check anything if Restoration is True, since we - -- may be detaching a static handler to restore a dynamic one. + -- Note: A null handler with Static=True will pass the following + -- check. That is the case when we want to Detach a handler + -- regardless of the Static status of the current_Handler. We don't + -- check anything if Restoration is True, since we may be detaching + -- a static handler to restore a dynamic one. if not Restoration and then not Static + -- Tries to overwrite a static Interrupt Handler with a -- dynamic Handler @@ -673,9 +625,9 @@ package body System.Interrupts is or else not Is_Registered (New_Handler)) then - Raise_Exception (Program_Error'Identity, + raise Program_Error with "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"); + "dynamic Handler"; end if; -- The interrupt should no longer be ingnored if it was ever ignored @@ -722,11 +674,12 @@ package body System.Interrupts is is begin if User_Entry (Interrupt).T /= Null_Task then + -- In case we have an Interrupt Entry installed. -- raise a program error. (propagate it to the caller). - Raise_Exception (Program_Error'Identity, - "An interrupt entry is already installed"); + raise Program_Error with + "An interrupt entry is already installed"; end if; -- Note : Static = True will pass the following check. That is the @@ -737,8 +690,8 @@ package body System.Interrupts is -- Tries to detach a static Interrupt Handler. -- raise a program error. - Raise_Exception (Program_Error'Identity, - "Trying to detach a static Interrupt Handler"); + raise Program_Error with + "Trying to detach a static Interrupt Handler"; end if; -- The interrupt should no longer be ignored if @@ -849,8 +802,8 @@ package body System.Interrupts is if User_Handler (Interrupt).H /= null or else User_Entry (Interrupt).T /= Null_Task then - Raise_Exception (Program_Error'Identity, - "A binding for this interrupt is already present"); + raise Program_Error with + "A binding for this interrupt is already present"; end if; -- The interrupt should no longer be ingnored if diff --git a/gcc/ada/s-interr-vxworks.adb b/gcc/ada/s-interr-vxworks.adb index 740b5076b6c..ec14f11c899 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-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -56,54 +56,31 @@ -- 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, --- we use the per-task lock of the Server_Task instead so that we protect the --- status between Interrupt_Manager and Server_Task. Protection among --- service requests are ensured via user calls to the Interrupt_Manager --- entries. +-- tables. If there is a Server_Task associated with a signal or interrupt, we +-- use the per-task lock of the Server_Task instead so that we protect the +-- status between Interrupt_Manager and Server_Task. Protection among service +-- requests are ensured via user calls to the Interrupt_Manager entries. -- This is the VxWorks version of this package, supporting vectored hardware -- interrupts. with Ada.Unchecked_Conversion; - -with System.OS_Interface; use System.OS_Interface; - -with Interfaces.VxWorks; - with Ada.Task_Identification; --- used for Task_Id type -with Ada.Exceptions; --- used for Raise_Exception +with Interfaces.VxWorks; +with System.OS_Interface; use System.OS_Interface; with System.Interrupt_Management; --- used for Reserve - with System.Task_Primitives.Operations; --- used for Write_Lock --- Unlock --- Abort --- Wakeup_Task --- Sleep --- Initialize_Lock - with System.Storage_Elements; --- used for To_Address --- To_Integer --- Integer_Address - with System.Tasking.Utilities; --- used for Make_Independent with System.Tasking.Rendezvous; --- used for Call_Simple pragma Elaborate_All (System.Tasking.Rendezvous); package body System.Interrupts is use Tasking; - use Ada.Exceptions; package POP renames System.Task_Primitives.Operations; @@ -310,9 +287,8 @@ package body System.Interrupts is procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception - (Program_Error'Identity, - "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; else return; end if; @@ -744,9 +720,7 @@ package body System.Interrupts is procedure Unimplemented (Feature : String) is begin - Raise_Exception - (Program_Error'Identity, - Feature & " not implemented on VxWorks"); + raise Program_Error with Feature & " not implemented on VxWorks"; end Unimplemented; ----------------------- @@ -823,8 +797,8 @@ package body System.Interrupts is -- If an interrupt entry is installed raise -- Program_Error. (propagate it to the caller). - Raise_Exception (Program_Error'Identity, - "An interrupt entry is already installed"); + raise Program_Error with + "An interrupt entry is already installed"; end if; -- Note : Static = True will pass the following check. This is the @@ -836,8 +810,8 @@ package body System.Interrupts is -- Trying to detach a static Interrupt Handler. raise -- Program_Error. - Raise_Exception (Program_Error'Identity, - "Trying to detach a static Interrupt Handler"); + raise Program_Error with + "Trying to detach a static Interrupt Handler"; end if; Old_Handler := User_Handler (Interrupt).H; @@ -869,9 +843,7 @@ package body System.Interrupts is -- If an interrupt entry is already installed, raise -- Program_Error. (propagate it to the caller). - Raise_Exception - (Program_Error'Identity, - "An interrupt is already installed"); + raise Program_Error with "An interrupt is already installed"; end if; -- Note : A null handler with Static = True will @@ -892,10 +864,9 @@ package body System.Interrupts is or else not Is_Registered (New_Handler)) then - Raise_Exception - (Program_Error'Identity, + raise Program_Error with "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"); + "dynamic Handler"; end if; -- Save the old handler @@ -1003,9 +974,8 @@ package body System.Interrupts is if User_Handler (Interrupt).H /= null or else User_Entry (Interrupt).T /= Null_Task then - Raise_Exception - (Program_Error'Identity, - "A binding for this interrupt is already present"); + raise Program_Error with + "A binding for this interrupt is already present"; end if; User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E); diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb index 6f112826c4a..7b4175eab59 100644 --- a/gcc/ada/s-interr.adb +++ b/gcc/ada/s-interr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -55,70 +55,23 @@ -- one Server_Task per interrupt. with Ada.Task_Identification; --- used for Task_Id type - -with Ada.Exceptions; --- used for Raise_Exception with System.Task_Primitives; --- used for RTS_Lock --- Self - with System.Interrupt_Management; --- used for Reserve --- Interrupt_ID --- Interrupt_Mask --- Abort_Task_Interrupt with System.Interrupt_Management.Operations; --- used for Thread_Block_Interrupt --- Thread_Unblock_Interrupt --- Install_Default_Action --- Install_Ignore_Action --- Copy_Interrupt_Mask --- Set_Interrupt_Mask --- Empty_Interrupt_Mask --- Fill_Interrupt_Mask --- Add_To_Interrupt_Mask --- Delete_From_Interrupt_Mask --- Interrupt_Wait --- Interrupt_Self_Process --- Get_Interrupt_Mask --- Set_Interrupt_Mask --- IS_Member --- Environment_Mask --- All_Tasks_Mask pragma Elaborate_All (System.Interrupt_Management.Operations); with System.Task_Primitives.Operations; --- used for Write_Lock --- Unlock --- Abort --- Wakeup_Task --- Sleep --- Initialize_Lock - with System.Task_Primitives.Interrupt_Operations; --- used for Set_Interrupt_ID - with System.Storage_Elements; --- used for To_Address --- To_Integer --- Integer_Address - with System.Tasking.Utilities; --- used for Make_Independent with System.Tasking.Rendezvous; --- used for Call_Simple pragma Elaborate_All (System.Tasking.Rendezvous); with System.Tasking.Initialization; --- used for Defer_Abort --- Undefer_Abort - with System.Parameters; --- used for Single_Lock with Ada.Unchecked_Conversion; @@ -126,7 +79,6 @@ package body System.Interrupts is use Parameters; use Tasking; - use Ada.Exceptions; package POP renames System.Task_Primitives.Operations; package PIO renames System.Task_Primitives.Interrupt_Operations; @@ -285,8 +237,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static); @@ -310,8 +262,8 @@ package body System.Interrupts is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt); @@ -324,8 +276,8 @@ package body System.Interrupts is procedure Block_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Block_Interrupt (Interrupt); @@ -340,8 +292,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; -- ??? Since Parameterless_Handler is not Atomic, the current @@ -368,8 +320,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Detach_Handler (Interrupt, Static); @@ -404,8 +356,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Exchange_Handler @@ -464,8 +416,8 @@ package body System.Interrupts is procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Ignore_Interrupt (Interrupt); @@ -506,8 +458,8 @@ package body System.Interrupts is function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Blocked (Interrupt); @@ -520,8 +472,8 @@ package body System.Interrupts is function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Entry (Interrupt).T /= Null_Task; @@ -534,8 +486,8 @@ package body System.Interrupts is function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return User_Handler (Interrupt).H /= null; @@ -548,8 +500,8 @@ package body System.Interrupts is function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Ignored (Interrupt); @@ -608,8 +560,8 @@ package body System.Interrupts is function Reference (Interrupt : Interrupt_ID) return System.Address is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Storage_Elements.To_Address @@ -656,8 +608,8 @@ package body System.Interrupts is procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Unblock_Interrupt (Interrupt); @@ -672,8 +624,8 @@ package body System.Interrupts is is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; return Last_Unblocker (Interrupt); @@ -686,8 +638,8 @@ package body System.Interrupts is procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is begin if Is_Reserved (Interrupt) then - Raise_Exception (Program_Error'Identity, "Interrupt" & - Interrupt_ID'Image (Interrupt) & " is reserved"); + raise Program_Error with + "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved"; end if; Interrupt_Manager.Unignore_Interrupt (Interrupt); @@ -825,8 +777,8 @@ package body System.Interrupts is -- In case we have an Interrupt Entry installed. -- raise a program error. (propagate it to the caller). - Raise_Exception (Program_Error'Identity, - "An interrupt entry is already installed"); + raise Program_Error with + "An interrupt entry is already installed"; end if; -- Note : Static = True will pass the following check. That is the @@ -838,8 +790,8 @@ package body System.Interrupts is -- Tries to detach a static Interrupt Handler. -- raise a program error. - Raise_Exception (Program_Error'Identity, - "Trying to detach a static Interrupt Handler"); + raise Program_Error with + "Trying to detach a static Interrupt Handler"; end if; -- The interrupt should no longer be ignored if @@ -876,8 +828,8 @@ package body System.Interrupts is -- In case we have an Interrupt Entry already installed. -- raise a program error. (propagate it to the caller). - Raise_Exception (Program_Error'Identity, - "An interrupt is already installed"); + raise Program_Error with + "An interrupt is already installed"; end if; -- Note : A null handler with Static = True will pass the @@ -899,9 +851,9 @@ package body System.Interrupts is or else not Is_Registered (New_Handler)) then - Raise_Exception (Program_Error'Identity, + raise Program_Error with "Trying to overwrite a static Interrupt Handler with a " & - "dynamic Handler"); + "dynamic Handler"; end if; -- The interrupt should no longer be ingnored if @@ -1062,8 +1014,8 @@ package body System.Interrupts is if User_Handler (Interrupt).H /= null or else User_Entry (Interrupt).T /= Null_Task then - Raise_Exception (Program_Error'Identity, - "A binding for this interrupt is already present"); + raise Program_Error with + "A binding for this interrupt is already present"; end if; -- The interrupt should no longer be ingnored if diff --git a/gcc/ada/s-interr.ads b/gcc/ada/s-interr.ads index a01b4c0b4fd..1eecfdb9af9 100644 --- a/gcc/ada/s-interr.ads +++ b/gcc/ada/s-interr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -35,24 +35,19 @@ -- Any changes to this interface may require corresponding compiler changes. -- This package encapsulates the implementation of interrupt or signal --- handlers. It is logically an extension of the body of Ada.Interrupts. --- It is made a child of System to allow visibility of various --- runtime system internal data and operations. +-- handlers. It is logically an extension of the body of Ada.Interrupts. 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 --- These two packages are separated in order to allow --- System.Interrupt_Management to be used without requiring the whole --- tasking implementation to be linked and elaborated. +-- These two packages are separated to allow System.Interrupt_Management to be +-- used without requiring the whole tasking implementation to be linked and +-- elaborated. with System.Tasking; --- used for Task_Id - with System.Tasking.Protected_Objects.Entries; --- used for Protection_Entries - with System.OS_Interface; --- used for Max_Interrupt package System.Interrupts is @@ -73,11 +68,9 @@ package System.Interrupts is type Interrupt_ID is range 0 .. System.OS_Interface.Max_Interrupt; - -- The following renaming is introduced so that the type is accessible - -- through rtsfind, otherwise the name clashes with its homonym in - -- ada.interrupts. - subtype System_Interrupt_Id is Interrupt_ID; + -- This synonym is introduced so that the type is accessible through + -- rtsfind, otherwise the name clashes with its homonym in Ada.Interrupts. type Parameterless_Handler is access protected procedure; @@ -97,10 +90,10 @@ package System.Interrupts is function Current_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 - -- regardless of the previous handler's binding status. - -- (i.e. we do not care whether it is a dynamic or static handler) + -- Calling the following procedures with New_Handler = null and Static = + -- true means that we want to modify the current handler regardless of the + -- previous handler's binding status. (i.e. we do not care whether it is a + -- dynamic or static handler) procedure Attach_Handler (New_Handler : Parameterless_Handler; @@ -150,8 +143,8 @@ package System.Interrupts is function Unblocked_By (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. + -- It returns Null_Task if no tasks have ever requested the Unblocking + -- operation or the Interrupt is currently Blocked. function Is_Blocked (Interrupt : Interrupt_ID) return Boolean; -- Comment needed ??? @@ -169,9 +162,9 @@ package System.Interrupts is -- other low-level interface that changes the signal action or signal mask -- needs a careful thought. - -- One may acheive the effect of system calls first making RTS blocked - -- (by calling Block_Interrupt) for the signal under consideration. - -- This will make all the tasks in RTS blocked for the Interrupt. + -- One may acheive the effect of system calls first making RTS blocked (by + -- calling Block_Interrupt) for the signal under consideration. This will + -- make all the tasks in RTS blocked for the Interrupt. ---------------------- -- Protection Types -- diff --git a/gcc/ada/s-intman-vms.ads b/gcc/ada/s-intman-vms.ads index ff0c8240193..ac06d118d54 100644 --- a/gcc/ada/s-intman-vms.ads +++ b/gcc/ada/s-intman-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -48,8 +48,6 @@ -- implemented as visible arrays rather than functions.) with System.OS_Interface; --- used for Signal --- sigset_t package System.Interrupt_Management is pragma Preelaborate; diff --git a/gcc/ada/s-intman-vxworks.ads b/gcc/ada/s-intman-vxworks.ads index ec332684521..538c4e5a0e1 100644 --- a/gcc/ada/s-intman-vxworks.ads +++ b/gcc/ada/s-intman-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -48,10 +48,8 @@ -- sets are implemeneted using visible arrays rather than functions. with System.OS_Interface; --- used for sigset_t with Interfaces.C; --- used for int package System.Interrupt_Management is pragma Preelaborate; diff --git a/gcc/ada/s-intman.ads b/gcc/ada/s-intman.ads index 528fbf45090..ae68d27a334 100644 --- a/gcc/ada/s-intman.ads +++ b/gcc/ada/s-intman.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -46,10 +46,8 @@ -- rather than functions. with System.OS_Interface; --- used for sigset_t with Interfaces.C; --- used for int package System.Interrupt_Management is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-aix.ads b/gcc/ada/s-osinte-aix.ads index 46caa9b6886..65db80a49de 100644 --- a/gcc/ada/s-osinte-aix.ads +++ b/gcc/ada/s-osinte-aix.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,14 +35,15 @@ -- This is a AIX (Native THREADS) version of this package -- This package encapsulates all direct interfaces to OS services that are --- needed by children of System. +-- needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-darwin.ads b/gcc/ada/s-osinte-darwin.ads index 17a48e89e62..da97aa0323c 100644 --- a/gcc/ada/s-osinte-darwin.ads +++ b/gcc/ada/s-osinte-darwin.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,12 +35,13 @@ -- This is Darwin pthreads version of this package -- This package includes all direct interfaces to OS services that are needed --- by children of System. +-- by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Elaborate_Body. It is designed to be a bottom-level (leaf) package. with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-dummy.ads b/gcc/ada/s-osinte-dummy.ads index 66e18187a2f..f459a64fdc6 100644 --- a/gcc/ada/s-osinte-dummy.ads +++ b/gcc/ada/s-osinte-dummy.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads index 86fe3f6ab7e..8794e995bd8 100644 --- a/gcc/ada/s-osinte-freebsd.ads +++ b/gcc/ada/s-osinte-freebsd.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -36,14 +36,15 @@ -- This is the FreeBSD PTHREADS version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-hpux-dce.ads b/gcc/ada/s-osinte-hpux-dce.ads index ac268c59480..687f9ecf6ad 100644 --- a/gcc/ada/s-osinte-hpux-dce.ads +++ b/gcc/ada/s-osinte-hpux-dce.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,14 +35,15 @@ -- This is the HP-UX version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-hpux.ads b/gcc/ada/s-osinte-hpux.ads index 61d0473e057..0e368919eeb 100644 --- a/gcc/ada/s-osinte-hpux.ads +++ b/gcc/ada/s-osinte-hpux.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -34,18 +34,16 @@ -- This is a HPUX 11.0 (Native THREADS) version of this package --- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. - --- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- This package encapsulates all direct interfaces to OS services that are +-- needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-irix.ads b/gcc/ada/s-osinte-irix.ads index 5c35032c2b7..15bd4007225 100644 --- a/gcc/ada/s-osinte-irix.ads +++ b/gcc/ada/s-osinte-irix.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -34,15 +34,16 @@ -- This is the SGI Pthreads version of this package --- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- This package encapsulates all direct interfaces to OS services that are +-- needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-linux-hppa.ads b/gcc/ada/s-osinte-linux-hppa.ads index 1c4386bfe82..2467f09cf5b 100644 --- a/gcc/ada/s-osinte-linux-hppa.ads +++ b/gcc/ada/s-osinte-linux-hppa.ads @@ -8,7 +8,7 @@ -- (GNU/Linux-HPPA Version) -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,15 +35,16 @@ -- This is a GNU/Linux (GNU/LinuxThreads) version of this package --- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- This package encapsulates all direct interfaces to OS services that are +-- needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads index 7299123deb7..bb06c01a0b8 100644 --- a/gcc/ada/s-osinte-linux.ads +++ b/gcc/ada/s-osinte-linux.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,14 +35,15 @@ -- This is a GNU/Linux (GNU/LinuxThreads) version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-lynxos-3.ads b/gcc/ada/s-osinte-lynxos-3.ads index eb775d2fcbd..f6ceec0790a 100644 --- a/gcc/ada/s-osinte-lynxos-3.ads +++ b/gcc/ada/s-osinte-lynxos-3.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,14 +35,15 @@ -- This is a LynxOS (Native) version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-lynxos.ads b/gcc/ada/s-osinte-lynxos.ads index cc28c19819c..90107631261 100644 --- a/gcc/ada/s-osinte-lynxos.ads +++ b/gcc/ada/s-osinte-lynxos.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,14 +35,15 @@ -- This is a LynxOS (POSIX Threads) version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; with Ada.Unchecked_Conversion; +with Interfaces.C; + package System.OS_Interface is pragma Preelaborate; diff --git a/gcc/ada/s-osinte-mingw.ads b/gcc/ada/s-osinte-mingw.ads index e0a3edf3a18..e0a3d7c75df 100644 --- a/gcc/ada/s-osinte-mingw.ads +++ b/gcc/ada/s-osinte-mingw.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,13 +35,15 @@ -- This is a NT (native) version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; + with Interfaces.C.Strings; + with Ada.Unchecked_Conversion; package System.OS_Interface is @@ -75,6 +77,8 @@ package System.OS_Interface is type PLONG is access all Interfaces.C.long; type PDWORD is access all DWORD; + type BYTE is new Interfaces.C.unsigned_char; + subtype CHAR is Interfaces.C.char; type BOOL is new Boolean; for BOOL'Size use Interfaces.C.unsigned_long'Size; @@ -95,6 +99,19 @@ package System.OS_Interface is NO_ERROR : constant := 0; FUNC_ERR : constant := -1; + ----------- + -- Files -- + ----------- + + type SECURITY_ATTRIBUTES is record + nLength : DWORD; + pSecurityDescriptor : PVOID; + bInheritHandle : BOOL; + end record; + + function CloseHandle (hObject : HANDLE) return BOOL; + pragma Import (Stdcall, CloseHandle, "CloseHandle"); + ------------------------ -- System Information -- ------------------------ @@ -259,30 +276,22 @@ package System.OS_Interface is function To_PTHREAD_START_ROUTINE is new Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE); - type SECURITY_ATTRIBUTES is record - nLength : DWORD; - pSecurityDescriptor : PVOID; - bInheritHandle : BOOL; - end record; - - type PSECURITY_ATTRIBUTES is access all SECURITY_ATTRIBUTES; - function CreateThread - (pThreadAttributes : PSECURITY_ATTRIBUTES; - dwStackSize : DWORD; - pStartAddress : PTHREAD_START_ROUTINE; - pParameter : PVOID; - dwCreationFlags : DWORD; - pThreadId : PDWORD) return HANDLE; + (pThreadAttributes : access SECURITY_ATTRIBUTES; + dwStackSize : DWORD; + pStartAddress : PTHREAD_START_ROUTINE; + pParameter : PVOID; + dwCreationFlags : DWORD; + pThreadId : PDWORD) return HANDLE; pragma Import (Stdcall, CreateThread, "CreateThread"); function BeginThreadEx - (pThreadAttributes : PSECURITY_ATTRIBUTES; - dwStackSize : DWORD; - pStartAddress : PTHREAD_START_ROUTINE; - pParameter : PVOID; - dwCreationFlags : DWORD; - pThreadId : PDWORD) return HANDLE; + (pThreadAttributes : access SECURITY_ATTRIBUTES; + dwStackSize : DWORD; + pStartAddress : PTHREAD_START_ROUTINE; + pParameter : PVOID; + dwCreationFlags : DWORD; + pThreadId : PDWORD) return HANDLE; pragma Import (C, BeginThreadEx, "_beginthreadex"); Debug_Process : constant := 16#00000001#; @@ -373,11 +382,8 @@ package System.OS_Interface is -- Semaphores, Events and Mutexes -- ------------------------------------ - function CloseHandle (hObject : HANDLE) return BOOL; - pragma Import (Stdcall, CloseHandle, "CloseHandle"); - function CreateSemaphore - (pSemaphoreAttributes : PSECURITY_ATTRIBUTES; + (pSemaphoreAttributes : access SECURITY_ATTRIBUTES; lInitialCount : Interfaces.C.long; lMaximumCount : Interfaces.C.long; pName : PSZ) return HANDLE; @@ -396,7 +402,7 @@ package System.OS_Interface is pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore"); function CreateEvent - (pEventAttributes : PSECURITY_ATTRIBUTES; + (pEventAttributes : access SECURITY_ATTRIBUTES; bManualReset : BOOL; bInitialState : BOOL; pName : PSZ) return HANDLE; @@ -418,7 +424,7 @@ package System.OS_Interface is pragma Import (Stdcall, PulseEvent, "PulseEvent"); function CreateMutex - (pMutexAttributes : PSECURITY_ATTRIBUTES; + (pMutexAttributes : access SECURITY_ATTRIBUTES; bInitialOwner : BOOL; pName : PSZ) return HANDLE; pragma Import (Stdcall, CreateMutex, "CreateMutexA"); diff --git a/gcc/ada/s-osinte-solaris-posix.ads b/gcc/ada/s-osinte-solaris-posix.ads index d887f434f3f..c45dca19cfc 100644 --- a/gcc/ada/s-osinte-solaris-posix.ads +++ b/gcc/ada/s-osinte-solaris-posix.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,12 +35,13 @@ -- This is a Solaris (POSIX Threads) version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; + with Ada.Unchecked_Conversion; package System.OS_Interface is diff --git a/gcc/ada/s-osinte-solaris.ads b/gcc/ada/s-osinte-solaris.ads index 9a4a4bab756..32213ccabd4 100644 --- a/gcc/ada/s-osinte-solaris.ads +++ b/gcc/ada/s-osinte-solaris.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,12 +35,13 @@ -- This is a Solaris (native) version of this package -- This package includes all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; + with Ada.Unchecked_Conversion; package System.OS_Interface is diff --git a/gcc/ada/s-osinte-tru64.ads b/gcc/ada/s-osinte-tru64.ads index 98f20a6c0ae..512267780b0 100644 --- a/gcc/ada/s-osinte-tru64.ads +++ b/gcc/ada/s-osinte-tru64.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -32,15 +32,16 @@ -- -- ------------------------------------------------------------------------------ --- This is the DEC Unix 4.0/5.1 version of this package +-- This is the Tru64 version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; + with Ada.Unchecked_Conversion; package System.OS_Interface is diff --git a/gcc/ada/s-osinte-vms.ads b/gcc/ada/s-osinte-vms.ads index a572847e066..74f08ea4664 100644 --- a/gcc/ada/s-osinte-vms.ads +++ b/gcc/ada/s-osinte-vms.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,13 +35,15 @@ -- This is a OpenVMS/Alpha version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; + with Ada.Unchecked_Conversion; + with System.Aux_DEC; package System.OS_Interface is diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads index 9684e78ac77..3204b4bb267 100644 --- a/gcc/ada/s-osinte-vxworks.ads +++ b/gcc/ada/s-osinte-vxworks.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,12 +35,13 @@ -- This is the VxWorks version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; + with System.VxWorks; package System.OS_Interface is diff --git a/gcc/ada/s-osinte-vxworks6.ads b/gcc/ada/s-osinte-vxworks6.ads index ad523c3aa75..4ef43c9c31f 100644 --- a/gcc/ada/s-osinte-vxworks6.ads +++ b/gcc/ada/s-osinte-vxworks6.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,7 +35,7 @@ -- This is the VxWorks 6.x version of this package -- This package encapsulates all direct interfaces to OS services --- that are needed by children of System. +-- that are needed by the tasking run-time (libgnarl). -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. @@ -135,12 +135,12 @@ package System.OS_Interface is -- Signal processing definitions -- ----------------------------------- - -- The how in sigprocmask(). + -- The how in sigprocmask() SIG_BLOCK : constant := 1; SIG_UNBLOCK : constant := 2; SIG_SETMASK : constant := 3; - -- The sa_flags in struct sigaction. + -- The sa_flags in struct sigaction SA_SIGINFO : constant := 16#0002#; SA_ONSTACK : constant := 16#0004#; diff --git a/gcc/ada/s-osprim-vxworks.adb b/gcc/ada/s-osprim-vxworks.adb index 901954bb53b..62fde6a7af1 100644 --- a/gcc/ada/s-osprim-vxworks.adb +++ b/gcc/ada/s-osprim-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2008, 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- -- @@ -40,7 +40,6 @@ with System.OS_Interface; -- create a dependency on libgnarl in libgnat, which is not desirable. with Interfaces.C; --- used for type int package body System.OS_Primitives is diff --git a/gcc/ada/s-shasto.adb b/gcc/ada/s-shasto.adb index 85e47eda428..5dd775725bb 100644 --- a/gcc/ada/s-shasto.adb +++ b/gcc/ada/s-shasto.adb @@ -31,7 +31,6 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Exceptions; with Ada.IO_Exceptions; with Ada.Streams; @@ -483,10 +482,8 @@ package body System.Shared_Storage is -- Error if we cannot create the file when others => - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, - "Cannot create shared variable file for """ & - S & '"'); -- " + raise Program_Error with + "Cannot create shared variable file for """ & S & '"'; end; end; diff --git a/gcc/ada/s-soflin.adb b/gcc/ada/s-soflin.adb index c0787d1cc79..c54a31e045e 100644 --- a/gcc/ada/s-soflin.adb +++ b/gcc/ada/s-soflin.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -36,15 +36,13 @@ pragma Compiler_Unit; pragma Warnings (On); pragma Polling (Off); --- We must turn polling off for this unit, because otherwise we get --- an infinite loop from the code within the Poll routine itself. +-- We must turn polling off for this unit, because otherwise we get an +-- infinite loop from the code within the Poll routine itself. with System.Parameters; --- Used for Sec_Stack_Ratio pragma Warnings (Off); --- Disable warnings since System.Secondary_Stack is currently not --- Preelaborate +-- Disable warnings since System.Secondary_Stack is currently not Preelaborate with System.Secondary_Stack; pragma Warnings (On); diff --git a/gcc/ada/s-solita.adb b/gcc/ada/s-solita.adb index 0ce4b73fe32..ecf0f238995 100644 --- a/gcc/ada/s-solita.adb +++ b/gcc/ada/s-solita.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2008, 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- -- @@ -32,31 +32,20 @@ ------------------------------------------------------------------------------ pragma Style_Checks (All_Checks); --- Turn off subprogram alpha ordering check, since we group soft link --- bodies and dummy soft link bodies together separately in this unit. +-- Turn off subprogram alpha ordering check, since we group soft link bodies +-- and dummy soft link bodies together separately in this unit. pragma Polling (Off); --- Turn polling off for this package. We don't need polling during any --- of the routines in this package, and more to the point, if we try --- to poll it can cause infinite loops. +-- Turn polling off for this package. We don't need polling during any of the +-- routines in this package, and more to the point, if we try to poll it can +-- cause infinite loops. -with System.Task_Primitives.Operations; --- Used for Self --- Timed_Delay +with Ada.Exceptions; +with Ada.Exceptions.Is_Null_Occurrence; +with System.Task_Primitives.Operations; with System.Tasking; --- Used for Task_Id --- Cause_Of_Termination - with System.Stack_Checking; --- Used for Stack_Access - -with Ada.Exceptions; --- Used for Exception_Id --- Exception_Occurrence --- Save_Occurrence - -with Ada.Exceptions.Is_Null_Occurrence; package body System.Soft_Links.Tasking is diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb index 28e31e0ec93..84a8504fb11 100644 --- a/gcc/ada/s-taasde.adb +++ b/gcc/ada/s-taasde.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2008, 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- -- @@ -35,46 +35,17 @@ pragma Polling (Off); -- Turn off polling, we do not want ATC polling to take place during -- tasking operations. It causes infinite loops and other problems. -with Ada.Exceptions; --- Used for Raise_Exception +with Ada.Unchecked_Conversion; +with Ada.Task_Identification; with System.Task_Primitives.Operations; --- Used for Write_Lock, --- Unlock, --- Self, --- Monotonic_Clock, --- Self, --- Timed_Sleep, --- Wakeup, --- Yield - with System.Tasking.Utilities; --- Used for Make_Independent - with System.Tasking.Initialization; --- Used for Defer_Abort --- Undefer_Abort - with System.Tasking.Debug; --- Used for Trace - with System.OS_Primitives; --- used for Max_Sensible_Delay - -with Ada.Task_Identification; --- used for Task_Id type - with System.Interrupt_Management.Operations; --- used for Setup_Interrupt_Mask - with System.Parameters; --- used for Single_Lock --- Runtime_Traces - with System.Traces.Tasking; --- used for Send_Trace_Info - -with Ada.Unchecked_Conversion; package body System.Tasking.Async_Delays is @@ -228,8 +199,7 @@ package body System.Tasking.Async_Delays is "async delay from within abort-deferred region"); if Self_Id.ATC_Nesting_Level = ATC_Level'Last then - Ada.Exceptions.Raise_Exception (Storage_Error'Identity, - "not enough ATC nesting levels"); + raise Storage_Error with "not enough ATC nesting levels"; end if; Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1; diff --git a/gcc/ada/s-taenca.adb b/gcc/ada/s-taenca.adb index 3da82bf60ba..0f4b0c8fa4d 100644 --- a/gcc/ada/s-taenca.adb +++ b/gcc/ada/s-taenca.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,36 +32,13 @@ ------------------------------------------------------------------------------ with System.Task_Primitives.Operations; --- used for STPO.Write_Lock --- Unlock --- STPO.Get_Priority --- Sleep --- Timed_Sleep - with System.Tasking.Initialization; --- used for Change_Base_Priority --- Defer_Abort/Undefer_Abort - with System.Tasking.Protected_Objects.Entries; --- used for To_Protection - with System.Tasking.Protected_Objects.Operations; --- used for PO_Service_Entries - with System.Tasking.Queuing; --- used for Requeue_Call_With_New_Prio --- Onqueue --- Dequeue_Call - with System.Tasking.Utilities; --- used for Exit_One_ATC_Level - with System.Parameters; --- used for Single_Lock --- Runtime_Traces - with System.Traces; --- used for Send_Trace_Info package body System.Tasking.Entry_Calls is diff --git a/gcc/ada/s-taprob.adb b/gcc/ada/s-taprob.adb index 603d9a268d7..547dcb72264 100644 --- a/gcc/ada/s-taprob.adb +++ b/gcc/ada/s-taprob.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2006, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -37,19 +37,9 @@ pragma Polling (Off); -- tasking operations. It causes infinite loops and other problems. with System.Task_Primitives.Operations; --- used for Write_Lock --- Unlock --- Self --- Set_Ceiling - with System.Parameters; --- used for Runtime_Traces - with System.Traces; --- used for Send_Trace_Info - with System.Soft_Links.Tasking; --- Used for Init_Tasking_Soft_Links package body System.Tasking.Protected_Objects is diff --git a/gcc/ada/s-taprop-dummy.adb b/gcc/ada/s-taprop-dummy.adb index a64a61cd9dd..20f8404e0fc 100644 --- a/gcc/ada/s-taprop-dummy.adb +++ b/gcc/ada/s-taprop-dummy.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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,15 +33,14 @@ -- This is a no tasking version of this package --- This package contains all the GNULL primitives that interface directly --- with the underlying OS. +-- This package contains all the GNULL primitives that interface directly with +-- the underlying OS. pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.Error_Reporting; --- used for Shutdown package body System.Task_Primitives.Operations is diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index b962b890a07..329c56f8ccb 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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,50 +33,34 @@ -- This is a HP-UX DCE threads (HPUX 10) version of this package --- This package contains all the GNULL primitives that interface directly --- with the underlying OS. +-- This package contains all the GNULL primitives that interface directly with +-- the underlying OS. pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. -with System.Tasking.Debug; --- used for Known_Tasks +with Ada.Unchecked_Conversion; +with Ada.Unchecked_Deallocation; + +with Interfaces.C; +with System.Tasking.Debug; with System.Interrupt_Management; --- used for Keep_Unmasked --- Abort_Task_Interrupt --- Interrupt_ID +with System.OS_Primitives; +with System.Task_Primitives.Interrupt_Operations; pragma Warnings (Off); with System.Interrupt_Management.Operations; --- used for Set_Interrupt_Mask --- All_Tasks_Mask pragma Elaborate_All (System.Interrupt_Management.Operations); - pragma Warnings (On); -with System.OS_Primitives; --- used for Delay_Modes - -with Interfaces.C; --- used for int --- size_t - -with System.Task_Primitives.Interrupt_Operations; --- used for Get_Interrupt_ID - with System.Soft_Links; --- used for Defer/Undefer_Abort - -- We use System.Soft_Links instead of System.Tasking.Initialization -- because the later is a higher level package that we shouldn't depend on. -- For example when using the restricted run time, it is replaced by -- System.Tasking.Restricted.Stages. -with Ada.Unchecked_Conversion; -with Ada.Unchecked_Deallocation; - package body System.Task_Primitives.Operations is package SSL renames System.Soft_Links; diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 330519db8ea..068d3401f62 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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,47 +33,32 @@ -- This is a Solaris (native) version of this package --- This package contains all the GNULL primitives that interface directly --- with the underlying OS. +-- This package contains all the GNULL primitives that interface directly with +-- the underlying OS. pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. -with System.Tasking.Debug; --- used for Known_Tasks +with Ada.Unchecked_Deallocation; -with System.Interrupt_Management; --- used for Keep_Unmasked --- Abort_Task_Interrupt --- Interrupt_ID +with Interfaces.C; +with System.Tasking.Debug; +with System.Interrupt_Management; with System.OS_Primitives; --- used for Delay_Modes +with System.Task_Info; pragma Warnings (Off); with System.OS_Lib; --- used for String_Access, Getenv - pragma Warnings (On); -with Interfaces.C; --- used for int --- size_t - -with System.Task_Info; --- to initialize Task_Info for a C thread, in function Self - with System.Soft_Links; --- used for Defer/Undefer_Abort - -- We use System.Soft_Links instead of System.Tasking.Initialization -- because the later is a higher level package that we shouldn't depend on. -- For example when using the restricted run time, it is replaced by -- System.Tasking.Restricted.Stages. -with Ada.Unchecked_Deallocation; - package body System.Task_Primitives.Operations is package SSL renames System.Soft_Links; diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index 7094ed5f978..f1be10194a4 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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,32 +33,22 @@ -- This is a OpenVMS/Alpha version of this package --- This package contains all the GNULL primitives that interface directly --- with the underlying OS. +-- This package contains all the GNULL primitives that interface directly with +-- the underlying OS. pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. -with System.Tasking.Debug; --- used for Known_Tasks - -with System.OS_Primitives; --- used for Delay_Modes +with Ada.Unchecked_Conversion; +with Ada.Unchecked_Deallocation; with Interfaces.C; --- used for int --- size_t +with System.Tasking.Debug; +with System.OS_Primitives; with System.Soft_Links; --- used for Get_Exc_Stack_Addr --- Abort_Defer/Undefer - with System.Aux_DEC; --- used for Short_Address - -with Ada.Unchecked_Conversion; -with Ada.Unchecked_Deallocation; package body System.Task_Primitives.Operations is diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads index d45ef18b990..7938ae1002e 100644 --- a/gcc/ada/s-taprop.ads +++ b/gcc/ada/s-taprop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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,17 +31,12 @@ -- -- ------------------------------------------------------------------------------ --- This package contains all the GNULL primitives that interface directly --- with the underlying OS. +-- This package contains all the GNULL primitives that interface directly with +-- the underlying OS. with System.Parameters; --- used for Size_Type - with System.Tasking; --- used for Task_Id - with System.OS_Interface; --- used for Thread_Id package System.Task_Primitives.Operations is pragma Preelaborate; diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 509b0d030ef..08802c6e22f 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2008, 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- -- @@ -46,31 +46,18 @@ pragma Polling (Off); -- tasking operations. It causes infinite loops and other problems. with Ada.Exceptions; --- used for Exception_Occurrence with System.Task_Primitives.Operations; --- used for Enter_Task --- Write_Lock --- Unlock --- Wakeup --- Get_Priority - -with System.Soft_Links; --- used for the non-tasking routines (*_NT) that refer to global data. --- They are needed here before the tasking run time has been elaborated. --- used for Create_TSD --- This package also provides initialization routines for task specific data. --- The GNARL must call these to be sure that all non-tasking --- Ada constructs will work. - with System.Soft_Links.Tasking; --- Used for Init_Tasking_Soft_Links - with System.Secondary_Stack; --- used for SS_Init; - with System.Storage_Elements; --- used for Storage_Array; + +with System.Soft_Links; +-- Used for the non-tasking routines (*_NT) that refer to global data. They +-- are needed here before the tasking run time has been elaborated. used for +-- Create_TSD This package also provides initialization routines for task +-- specific data. The GNARL must call these to be sure that all non-tasking +-- Ada constructs will work. package body System.Tasking.Restricted.Stages is diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index 1525bd9ea1e..6f0e36b43e6 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -46,10 +46,7 @@ -- System.Protected_Objects.Single_Entry with System.Task_Info; --- used for Task_Info_Type - with System.Parameters; --- used for Size_Type package System.Tasking.Restricted.Stages is pragma Elaborate_Body; diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb index 5b3bb2d29e5..557bf9a8cb3 100644 --- a/gcc/ada/s-tasini.adb +++ b/gcc/ada/s-tasini.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,38 +32,22 @@ ------------------------------------------------------------------------------ pragma Style_Checks (All_Checks); --- Turn off subprogram alpha ordering check, since we group soft link --- bodies and dummy soft link bodies together separately in this unit. +-- Turn off subprogram alpha ordering check, since we group soft link bodies +-- and dummy soft link bodies together separately in this unit. pragma Polling (Off); --- Turn polling off for this package. We don't need polling during any --- of the routines in this package, and more to the point, if we try --- to poll it can cause infinite loops. +-- Turn polling off for this package. We don't need polling during any of the +-- routines in this package, and more to the point, if we try to poll it can +-- cause infinite loops. with Ada.Exceptions; --- Used for Exception_Occurrence_Access with System.Task_Primitives; --- Used for Lock - with System.Task_Primitives.Operations; --- Used for Set_Priority --- Write_Lock --- Unlock --- Initialize_Lock - with System.Soft_Links; --- Used for the non-tasking routines (*_NT) that refer to global data. --- They are needed here before the tasking run time has been elaborated. - with System.Soft_Links.Tasking; --- Used for Init_Tasking_Soft_Links - with System.Tasking.Debug; --- Used for Trace - with System.Parameters; --- used for Single_Lock package body System.Tasking.Initialization is diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 3a4cbe55945..7d78f5112a7 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,14 +32,11 @@ ------------------------------------------------------------------------------ pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.Task_Primitives.Operations; --- used for Self - with System.Storage_Elements; --- Needed for initializing Stack_Info.Size package body System.Tasking is diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index e8c0653deb6..045f176db02 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -37,25 +37,13 @@ -- Any changes to this interface may require corresponding compiler changes. with Ada.Exceptions; --- Used for Exception_Id --- Exception_Occurrence +with Ada.Unchecked_Conversion; with System.Parameters; --- used for Size_Type - with System.Task_Info; --- used for Task_Info_Type - with System.Soft_Links; --- used for TSD - with System.Task_Primitives; --- used for Private_Data - with System.Stack_Usage; --- used for Stack_Analyzer - -with Ada.Unchecked_Conversion; package System.Tasking is pragma Preelaborate; diff --git a/gcc/ada/s-tasloc.adb b/gcc/ada/s-tasloc.adb index 71a8fce635a..6220c6ba022 100755 --- a/gcc/ada/s-tasloc.adb +++ b/gcc/ada/s-tasloc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2007, AdaCore -- +-- Copyright (C) 1997-2008, AdaCore -- -- -- -- 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- -- @@ -32,7 +32,6 @@ ------------------------------------------------------------------------------ with System.Soft_Links; --- used for Lock_Task, Unlock_Task package body System.Task_Lock is diff --git a/gcc/ada/s-taspri-dummy.ads b/gcc/ada/s-taspri-dummy.ads index 76be710e60e..06cb9c13d6e 100644 --- a/gcc/ada/s-taspri-dummy.ads +++ b/gcc/ada/s-taspri-dummy.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -34,8 +34,8 @@ -- This is a no tasking version of this package pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-hpux-dce.ads b/gcc/ada/s-taspri-hpux-dce.ads index 311df3fcae2..9ed8b011129 100644 --- a/gcc/ada/s-taspri-hpux-dce.ads +++ b/gcc/ada/s-taspri-hpux-dce.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -36,13 +36,10 @@ -- This package provides low-level support for most tasking features pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.OS_Interface; --- used for pthread_mutex_t --- pthread_cond_t --- pthread_t package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-lynxos.ads b/gcc/ada/s-taspri-lynxos.ads index 03eb447ac3f..7d85e67392f 100644 --- a/gcc/ada/s-taspri-lynxos.ads +++ b/gcc/ada/s-taspri-lynxos.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2005, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,13 +35,10 @@ -- This is a LynxOS version of this package, derived from s-taspri-posix.ads pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.OS_Interface; --- used for pthread_mutex_t --- pthread_cond_t --- pthread_t package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-mingw.ads b/gcc/ada/s-taspri-mingw.ads index 8af68156a10..5997cba640c 100644 --- a/gcc/ada/s-taspri-mingw.ads +++ b/gcc/ada/s-taspri-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -34,13 +34,10 @@ -- This is a NT (native) version of this package pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.OS_Interface; --- used for pthread_mutex_t --- pthread_cond_t --- pthread_t package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-posix.ads b/gcc/ada/s-taspri-posix.ads index 22bad81b4e0..c59a780c161 100644 --- a/gcc/ada/s-taspri-posix.ads +++ b/gcc/ada/s-taspri-posix.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2005, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -37,13 +37,10 @@ -- Note: this file can only be used for POSIX compliant systems pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.OS_Interface; --- used for pthread_mutex_t --- pthread_cond_t --- pthread_t package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-solaris.ads b/gcc/ada/s-taspri-solaris.ads index 3f4772bfc01..810f89c61a6 100644 --- a/gcc/ada/s-taspri-solaris.ads +++ b/gcc/ada/s-taspri-solaris.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -36,16 +36,13 @@ -- This package provides low-level support for most tasking features pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. - -with System.OS_Interface; --- used for mutex_t --- cond_t --- thread_t +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with Ada.Unchecked_Conversion; +with System.OS_Interface; + package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-tru64.ads b/gcc/ada/s-taspri-tru64.ads index db281adc32e..d666dfea396 100644 --- a/gcc/ada/s-taspri-tru64.ads +++ b/gcc/ada/s-taspri-tru64.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -36,17 +36,12 @@ -- This package provides low-level support for most tasking features pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with Interfaces.C; --- used for int --- size_t with System.OS_Interface; --- used for pthread_mutex_t --- pthread_cond_t --- pthread_t package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-vms.ads b/gcc/ada/s-taspri-vms.ads index 7f3d8eae3e8..d2e78cb6cb6 100644 --- a/gcc/ada/s-taspri-vms.ads +++ b/gcc/ada/s-taspri-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1991-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1991-2008, 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- -- @@ -36,17 +36,12 @@ -- This package provides low-level support for most tasking features pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with Interfaces.C; --- used for int --- size_t with System.OS_Interface; --- used for pthread_mutex_t --- pthread_cond_t --- pthread_t package System.Task_Primitives is pragma Preelaborate; diff --git a/gcc/ada/s-taspri-vxworks.ads b/gcc/ada/s-taspri-vxworks.ads index e42535cae00..b499b217bec 100644 --- a/gcc/ada/s-taspri-vxworks.ads +++ b/gcc/ada/s-taspri-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2006 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, 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- -- @@ -34,8 +34,8 @@ -- This is a VxWorks version of this package pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.OS_Interface; diff --git a/gcc/ada/s-tasque.adb b/gcc/ada/s-tasque.adb index 55b41c7fae9..7a4aac8d386 100644 --- a/gcc/ada/s-tasque.adb +++ b/gcc/ada/s-tasque.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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,19 +31,13 @@ -- -- ------------------------------------------------------------------------------ --- This version of the body implements queueing policy according to the --- policy specified by the pragma Queuing_Policy. When no such pragma --- is specified FIFO policy is used as default. +-- This version of the body implements queueing policy according to the policy +-- specified by the pragma Queuing_Policy. When no such pragma is specified +-- FIFO policy is used as default. with System.Task_Primitives.Operations; --- used for Write_Lock --- Unlock - with System.Tasking.Initialization; --- used for Wakeup_Entry_Caller - with System.Parameters; --- used for Single_Lock package body System.Tasking.Queuing is diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 40111c8fd3a..d7cbc01ebc8 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,53 +32,15 @@ ------------------------------------------------------------------------------ with System.Task_Primitives.Operations; --- used for Get_Priority --- Set_Priority --- Write_Lock --- Unlock --- Sleep --- Wakeup --- Timed_Sleep - with System.Tasking.Entry_Calls; --- Used for Wait_For_Completion --- Wait_For_Completion_With_Timeout --- Wait_Until_Abortable - with System.Tasking.Initialization; --- used for Defer_Abort --- Undefer_Abort --- Do_Pending_Action - with System.Tasking.Queuing; --- used for Enqueue --- Dequeue_Head --- Select_Task_Entry_Call --- Count_Waiting - with System.Tasking.Utilities; --- used for Check_Exception --- Make_Passive --- Wakeup_Entry_Caller --- Exit_One_ATC_Level - with System.Tasking.Protected_Objects.Operations; --- used for PO_Do_Or_Queue --- PO_Service_Entries --- Lock_Entries - with System.Tasking.Debug; --- used for Trace - with System.Restrictions; --- used for Abort_Allowed - with System.Parameters; --- used for Single_Lock --- Runtime_Traces - with System.Traces.Tasking; --- used for Send_Trace_Info package body System.Tasking.Rendezvous is @@ -402,8 +364,7 @@ package body System.Tasking.Rendezvous is if System.Tasking.Detect_Blocking and then STPO.Self.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; Call_Synchronous @@ -1037,8 +998,7 @@ package body System.Tasking.Rendezvous is end if; Initialization.Undefer_Abort (Self_Id); - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "Entry call not a delay mode"); + raise Program_Error with "Entry call not a delay mode"; end if; end case; @@ -1351,8 +1311,7 @@ package body System.Tasking.Rendezvous is if System.Tasking.Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; if Parameters.Runtime_Traces then @@ -1719,8 +1678,7 @@ package body System.Tasking.Rendezvous is if System.Tasking.Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; Initialization.Defer_Abort (Self_Id); diff --git a/gcc/ada/s-tasren.ads b/gcc/ada/s-tasren.ads index 67fdc5a1437..73f74ba75fe 100644 --- a/gcc/ada/s-tasren.ads +++ b/gcc/ada/s-tasren.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -35,10 +35,8 @@ -- Any changes to this interface may require corresponding compiler changes. with Ada.Exceptions; --- Used for, Exception_Id with System.Tasking.Protected_Objects.Entries; --- used for Protection_Entries package System.Tasking.Rendezvous is diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 9c574f06dc8..22da42bb08f 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,79 +32,36 @@ ------------------------------------------------------------------------------ pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with Ada.Exceptions; --- Used for Raise_Exception +with Ada.Unchecked_Deallocation; with System.Tasking.Debug; --- Used for enabling tasking facilities with gdb - with System.Address_Image; --- Used for the function itself - with System.Task_Primitives.Operations; --- Used for Finalize_Lock --- Enter_Task --- Write_Lock --- Unlock --- Sleep --- Wakeup --- Get_Priority --- Lock/Unlock_RTS --- New_ATCB - -with System.Soft_Links; --- These are procedure pointers to non-tasking routines that use task --- specific data. In the absence of tasking, these routines refer to global --- data. In the presense of tasking, they must be replaced with pointers to --- task-specific versions. Also used for Create_TSD, Destroy_TSD, --- Get_Current_Excep, Finalize_Global_List, Task_Termination, Handler. - -with System.Tasking.Initialization; --- Used for Remove_From_All_Tasks_List --- Defer_Abort --- Undefer_Abort --- Finalize_Attributes_Link --- Initialize_Attributes_Link - -pragma Elaborate_All (System.Tasking.Initialization); --- This insures that tasking is initialized if any tasks are created - with System.Tasking.Utilities; --- Used for Make_Passive --- Abort_One_Task --- Abort_Tasks - with System.Tasking.Queuing; --- Used for Dequeue_Head - with System.Tasking.Rendezvous; --- Used for Call_Simple - with System.OS_Primitives; --- Used for Delay_Modes - with System.Secondary_Stack; --- Used for SS_Init - with System.Storage_Elements; --- Used for Storage_Array - with System.Restrictions; --- Used for Abort_Allowed - with System.Standard_Library; --- Used for Exception_Trace - with System.Traces.Tasking; --- Used for Send_Trace_Info +with System.Stack_Usage; -with Ada.Unchecked_Deallocation; --- To recover from failure of ATCB initialization +with System.Soft_Links; +-- These are procedure pointers to non-tasking routines that use task +-- specific data. In the absence of tasking, these routines refer to global +-- data. In the presense of tasking, they must be replaced with pointers to +-- task-specific versions. Also used for Create_TSD, Destroy_TSD, +-- Get_Current_Excep, Finalize_Global_List, Task_Termination, Handler. -with System.Stack_Usage; +with System.Tasking.Initialization; +pragma Elaborate_All (System.Tasking.Initialization); +-- This insures that tasking is initialized if any tasks are created package body System.Tasking.Stages is @@ -166,20 +123,20 @@ package body System.Tasking.Stages is -- This procedure must be called with abort deferred. procedure Abort_Dependents (Self_ID : Task_Id); - -- Abort all the direct dependents of Self at its current master - -- nesting level, plus all of their dependents, transitively. - -- RTS_Lock should be locked by the caller. + -- Abort all the direct dependents of Self at its current master nesting + -- level, plus all of their dependents, transitively. RTS_Lock should be + -- locked by the caller. procedure Vulnerable_Free_Task (T : Task_Id); - -- Recover all runtime system storage associated with the task T. - -- This should only be called after T has terminated and will no - -- longer be referenced. + -- Recover all runtime system storage associated with the task T. This + -- should only be called after T has terminated and will no longer be + -- referenced. -- - -- For tasks created by an allocator that fails, due to an exception, - -- it is called from Expunge_Unactivated_Tasks. + -- For tasks created by an allocator that fails, due to an exception, it is + -- called from Expunge_Unactivated_Tasks. -- - -- It is also called from Ada.Unchecked_Deallocation, for objects that - -- are or contain tasks. + -- It is also called from Ada.Unchecked_Deallocation, for objects that are + -- or contain tasks. -- -- Different code is used at master completion, in Terminate_Dependents, -- due to a need for tighter synchronization with the master. @@ -233,28 +190,27 @@ package body System.Tasking.Stages is -- Activate_Tasks -- -------------------- - -- Note that locks of activator and activated task are both locked - -- here. This is necessary because C.Common.State and - -- Self.Common.Wait_Count have to be synchronized. This is safe from - -- deadlock because the activator is always created before the activated - -- task. That satisfies our in-order-of-creation ATCB locking policy. - - -- At one point, we may also lock the parent, if the parent is - -- different from the activator. That is also consistent with the - -- lock ordering policy, since the activator cannot be created - -- before the parent. - - -- Since we are holding both the activator's lock, and Task_Wrapper - -- locks that before it does anything more than initialize the - -- low-level ATCB components, it should be safe to wait to update - -- the counts until we see that the thread creation is successful. - - -- If the thread creation fails, we do need to close the entries - -- of the task. The first phase, of dequeuing calls, only requires - -- locking the acceptor's ATCB, but the waking up of the callers - -- requires locking the caller's ATCB. We cannot safely do this - -- while we are holding other locks. Therefore, the queue-clearing - -- operation is done in a separate pass over the activation chain. + -- Note that locks of activator and activated task are both locked here. + -- This is necessary because C.Common.State and Self.Common.Wait_Count have + -- to be synchronized. This is safe from deadlock because the activator is + -- always created before the activated task. That satisfies our + -- in-order-of-creation ATCB locking policy. + + -- At one point, we may also lock the parent, if the parent is different + -- from the activator. That is also consistent with the lock ordering + -- policy, since the activator cannot be created before the parent. + + -- Since we are holding both the activator's lock, and Task_Wrapper locks + -- that before it does anything more than initialize the low-level ATCB + -- components, it should be safe to wait to update the counts until we see + -- that the thread creation is successful. + + -- If the thread creation fails, we do need to close the entries of the + -- task. The first phase, of dequeuing calls, only requires locking the + -- acceptor's ATCB, but the waking up of the callers requires locking the + -- caller's ATCB. We cannot safely do this while we are holding other + -- locks. Therefore, the queue-clearing operation is done in a separate + -- pass over the activation chain. procedure Activate_Tasks (Chain_Access : Activation_Chain_Access) is Self_ID : constant Task_Id := STPO.Self; @@ -272,8 +228,7 @@ package body System.Tasking.Stages is if System.Tasking.Detect_Blocking and then Self_ID.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; pragma Debug @@ -299,8 +254,8 @@ package body System.Tasking.Stages is All_Elaborated := False; end if; - -- Reverse the activation chain so that tasks are - -- activated in the same order they're declared. + -- Reverse the activation chain so that tasks are activated in the + -- same order they're declared. Next_C := C.Common.Activation_Link; C.Common.Activation_Link := Last_C; @@ -313,8 +268,7 @@ package body System.Tasking.Stages is if not All_Elaborated then Unlock_RTS; Initialization.Undefer_Abort_Nestable (Self_ID); - Raise_Exception - (Program_Error'Identity, "Some tasks have not been elaborated"); + raise Program_Error with "Some tasks have not been elaborated"; end if; -- Activate all the tasks in the chain. Creation of the thread of @@ -341,10 +295,10 @@ package body System.Tasking.Stages is (C.Common.Compiler_Data.Pri_Stack_Info.Size), Activate_Prio, Success); - -- There would be a race between the created task and the - -- creator to do the following initialization, if we did not - -- have a Lock/Unlock_RTS pair in the task wrapper to prevent - -- it from racing ahead. + -- There would be a race between the created task and the creator + -- to do the following initialization, if we did not have a + -- Lock/Unlock_RTS pair in the task wrapper to prevent it from + -- racing ahead. if Success then C.Common.State := Runnable; @@ -380,8 +334,8 @@ package body System.Tasking.Stages is Unlock_RTS; end if; - -- Close the entries of any tasks that failed thread creation, - -- and count those that have not finished activation. + -- Close the entries of any tasks that failed thread creation, and count + -- those that have not finished activation. Write_Lock (Self_ID); Self_ID.Common.State := Activator_Sleep; @@ -428,8 +382,7 @@ package body System.Tasking.Stages is if Self_ID.Common.Activation_Failed then Self_ID.Common.Activation_Failed := False; - Raise_Exception (Tasking_Error'Identity, - "Failure during activation"); + raise Tasking_Error with "Failure during activation"; end if; end Activate_Tasks; @@ -500,8 +453,8 @@ package body System.Tasking.Stages is -- Create_Task -- ----------------- - -- Compiler interface only. Do not call from within the RTS. - -- This must be called to create a new task. + -- Compiler interface only. Do not call from within the RTS. This must be + -- called to create a new task. procedure Create_Task (Priority : Integer; @@ -534,15 +487,13 @@ package body System.Tasking.Stages is "create task after awaiting termination"; end if; - -- If pragma Detect_Blocking is active must be checked whether - -- this potentially blocking operation is called from a - -- protected action. + -- If pragma Detect_Blocking is active must be checked whether this + -- potentially blocking operation is called from a protected action. if System.Tasking.Detect_Blocking and then Self_ID.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; pragma Debug @@ -572,19 +523,18 @@ package body System.Tasking.Stages is exception when others => Initialization.Undefer_Abort_Nestable (Self_ID); - Raise_Exception (Storage_Error'Identity, "Cannot allocate task"); + raise Storage_Error with "Cannot allocate task"; end; - -- RTS_Lock is used by Abort_Dependents and Abort_Tasks. - -- Up to this point, it is possible that we may be part of - -- a family of tasks that is being aborted. + -- RTS_Lock is used by Abort_Dependents and Abort_Tasks. Up to this + -- point, it is possible that we may be part of a family of tasks that + -- is being aborted. Lock_RTS; Write_Lock (Self_ID); - -- Now, we must check that we have not been aborted. - -- If so, we should give up on creating this task, - -- and simply return. + -- Now, we must check that we have not been aborted. If so, we should + -- give up on creating this task, and simply return. if not Self_ID.Callable then pragma Assert (Self_ID.Pending_ATC_Level = 0); @@ -610,8 +560,7 @@ package body System.Tasking.Stages is Unlock (Self_ID); Unlock_RTS; Initialization.Undefer_Abort_Nestable (Self_ID); - Raise_Exception - (Storage_Error'Identity, "Failed to initialize task"); + raise Storage_Error with "Failed to initialize task"; end if; if Master = Foreign_Task_Level + 2 then @@ -710,8 +659,8 @@ package body System.Tasking.Stages is Initialization.Defer_Abort_Nestable (Self_ID); -- ??? - -- Experimentation has shown that abort is sometimes (but not - -- always) already deferred when this is called. + -- Experimentation has shown that abort is sometimes (but not always) + -- already deferred when this is called. -- That may indicate an error. Find out what is going on @@ -749,9 +698,9 @@ package body System.Tasking.Stages is --------------------------- -- ??? - -- We have a potential problem here if finalization of global - -- objects does anything with signals or the timer server, since - -- by that time those servers have terminated. + -- We have a potential problem here if finalization of global objects does + -- anything with signals or the timer server, since by that time those + -- servers have terminated. -- It is hard to see how that would occur @@ -767,11 +716,10 @@ package body System.Tasking.Stages is begin if Self_ID.Deferral_Level = 0 then -- ??? - -- In principle, we should be able to predict whether - -- abort is already deferred here (and it should not be deferred - -- yet but in practice it seems Finalize_Global_Tasks is being - -- called sometimes, from RTS code for exceptions, with abort already - -- deferred. + -- In principle, we should be able to predict whether abort is + -- already deferred here (and it should not be deferred yet but in + -- practice it seems Finalize_Global_Tasks is being called sometimes, + -- from RTS code for exceptions, with abort already deferred. Initialization.Defer_Abort_Nestable (Self_ID); @@ -802,17 +750,17 @@ package body System.Tasking.Stages is end if; -- We need to explicitely wait for the task to be terminated here - -- because on true concurrent system, we may end this procedure - -- before the tasks are really terminated. + -- because on true concurrent system, we may end this procedure before + -- the tasks are really terminated. Write_Lock (Self_ID); loop exit when Utilities.Independent_Task_Count = 0; - -- We used to yield here, but this did not take into account - -- low priority tasks that would cause dead lock in some cases - -- (true FIFO scheduling). + -- We used to yield here, but this did not take into account low + -- priority tasks that would cause dead lock in some cases (true + -- FIFO scheduling). Timed_Sleep (Self_ID, 0.01, System.OS_Primitives.Relative, @@ -1086,9 +1034,9 @@ package body System.Tasking.Stages is Stack_Guard (Self_ID, True); - -- Initialize low-level TCB components, that cannot be initialized - -- by the creator. Enter_Task sets Self_ID.Known_Tasks_Index and - -- also Self_ID.LL.Thread + -- Initialize low-level TCB components, that cannot be initialized by + -- the creator. Enter_Task sets Self_ID.Known_Tasks_Index and also + -- Self_ID.LL.Thread Enter_Task (Self_ID); @@ -1163,7 +1111,7 @@ package body System.Tasking.Stages is Cause := Abnormal; end if; when others => - -- ??? Using an E : others here causes CD2C11A to fail on Tru64. + -- ??? Using an E : others here causes CD2C11A to fail on Tru64 Initialization.Defer_Abort_Nestable (Self_ID); @@ -1231,10 +1179,10 @@ package body System.Tasking.Stages is -- Terminate_Task -- -------------------- - -- Before we allow the thread to exit, we must clean up. This is a - -- a delicate job. We must wake up the task's master, who may immediately - -- try to deallocate the ATCB out from under the current task WHILE IT IS - -- STILL EXECUTING. + -- Before we allow the thread to exit, we must clean up. This is a a + -- delicate job. We must wake up the task's master, who may immediately try + -- to deallocate the ATCB out from under the current task WHILE IT IS STILL + -- EXECUTING. -- To avoid this, the parent task must be blocked up to the latest -- statement executed. The trouble is that we have another step that we @@ -1314,8 +1262,8 @@ package body System.Tasking.Stages is SSL.Destroy_TSD (Self_ID.Common.Compiler_Data); Initialization.Final_Task_Unlock (Self_ID); - -- WARNING: past this point, this thread must assume that the ATCB - -- has been deallocated. It should not be accessed again. + -- WARNING: past this point, this thread must assume that the ATCB has + -- been deallocated. It should not be accessed again. if Master_of_Task > 0 then STPO.Exit_Task; @@ -1440,9 +1388,9 @@ package body System.Tasking.Stages is Unlock (Self_ID); Unlock (Activator); - -- After the activation, active priority should be the same - -- as base priority. We must unlock the Activator first, - -- though, since it should not wait if we have lower priority. + -- After the activation, active priority should be the same as base + -- priority. We must unlock the Activator first, though, since it + -- should not wait if we have lower priority. if Get_Priority (Self_ID) /= Self_ID.Common.Base_Priority then Write_Lock (Self_ID); @@ -1523,12 +1471,12 @@ package body System.Tasking.Stages is (Self_ID.Deferral_Level > 0 or else not System.Restrictions.Abort_Allowed); - -- Count how many active dependent tasks this master currently - -- has, and record this in Wait_Count. + -- Count how many active dependent tasks this master currently has, and + -- record this in Wait_Count. - -- This count should start at zero, since it is initialized to - -- zero for new tasks, and the task should not exit the - -- sleep-loops that use this count until the count reaches zero. + -- This count should start at zero, since it is initialized to zero for + -- new tasks, and the task should not exit the sleep-loops that use this + -- count until the count reaches zero. -- While we're counting, if we run across any unactivated tasks that -- belong to this master, we summarily terminate them as required by @@ -1543,6 +1491,7 @@ package body System.Tasking.Stages is -- Terminate unactivated (never-to-be activated) tasks if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then + pragma Assert (C.Common.State = Unactivated); -- Usually, C.Common.Activator = Self_ID implies C.Master_of_Task -- = CM. The only case where C is pending activation by this @@ -1581,9 +1530,8 @@ package body System.Tasking.Stages is -- Wait until dependent tasks are all terminated or ready to terminate. -- While waiting, the task may be awakened if the task's priority needs - -- changing, or this master is aborted. In the latter case, we want - -- to abort the dependents, and resume waiting until Wait_Count goes - -- to zero. + -- changing, or this master is aborted. In the latter case, we abort the + -- dependents, and resume waiting until Wait_Count goes to zero. Write_Lock (Self_ID); @@ -1612,9 +1560,8 @@ package body System.Tasking.Stages is Self_ID.Common.State := Runnable; Unlock (Self_ID); - -- Dependents are all terminated or on terminate alternatives. - -- Now, force those on terminate alternatives to terminate, by - -- aborting them. + -- Dependents are all terminated or on terminate alternatives. Now, + -- force those on terminate alternatives to terminate, by aborting them. pragma Assert (Check_Unactivated_Tasks); @@ -1644,14 +1591,14 @@ package body System.Tasking.Stages is -- rules prevent us from doing that without releasing the locks on C -- and Self_ID. Releasing and retaking those locks would be wasteful -- at best, and should not be considered further without more - -- detailed analysis of potential concurrent accesses to the - -- ATCBs of C and Self_ID. + -- detailed analysis of potential concurrent accesses to the ATCBs + -- of C and Self_ID. - -- Count how many "alive" dependent tasks this master currently - -- has, and record this in Wait_Count. This count should start at - -- zero, since it is initialized to zero for new tasks, and the - -- task should not exit the sleep-loops that use this count until - -- the count reaches zero. + -- Count how many "alive" dependent tasks this master currently has, + -- and record this in Wait_Count. This count should start at zero, + -- since it is initialized to zero for new tasks, and the task should + -- not exit the sleep-loops that use this count until the count + -- reaches zero. pragma Assert (Self_ID.Common.Wait_Count = 0); @@ -1699,10 +1646,10 @@ package body System.Tasking.Stages is -- fast as we can, so there is no point. -- Remove terminated tasks from the list of Self_ID's dependents, but - -- don't free their ATCBs yet, because of lock order restrictions, - -- which don't allow us to call "free" or "malloc" while holding any - -- other locks. Instead, we put those ATCBs to be freed onto a - -- temporary list, called To_Be_Freed. + -- don't free their ATCBs yet, because of lock order restrictions, which + -- don't allow us to call "free" or "malloc" while holding any other + -- locks. Instead, we put those ATCBs to be freed onto a temporary list, + -- called To_Be_Freed. if not Single_Lock then Lock_RTS; @@ -1747,13 +1694,12 @@ package body System.Tasking.Stages is -- ??? -- The check "T.Common.Parent /= null ..." below is to prevent dangling - -- references to terminated library-level tasks, which could - -- otherwise occur during finalization of library-level objects. - -- A better solution might be to hook task objects into the - -- finalization chain and deallocate the ATCB when the task - -- object is deallocated. However, this change is not likely - -- to gain anything significant, since all this storage should - -- be recovered en-masse when the process exits. + -- references to terminated library-level tasks, which could otherwise + -- occur during finalization of library-level objects. A better solution + -- might be to hook task objects into the finalization chain and + -- deallocate the ATCB when the task object is deallocated. However, + -- this change is not likely to gain anything significant, since all + -- this storage should be recovered en-masse when the process exits. while To_Be_Freed /= null loop T := To_Be_Freed; @@ -1803,6 +1749,7 @@ package body System.Tasking.Stages is -- ATCB. That would not cover the case of unactivated tasks. It also -- would force us to keep the underlying thread around past termination, -- since references to the ATCB are possible past termination. + -- Currently, we get rid of the thread as soon as the task terminates, -- and let the parent recover the ATCB later. @@ -1812,9 +1759,8 @@ package body System.Tasking.Stages is -- that no longer have ATCBs. It is not clear how much this would gain, -- since the user-level task object would still be occupying storage. - -- Make next master level up active. - -- We don't need to lock the ATCB, since the value is only updated by - -- each task for itself. + -- Make next master level up active. We don't need to lock the ATCB, + -- since the value is only updated by each task for itself. Self_ID.Master_Within := CM - 1; end Vulnerable_Complete_Master; @@ -1876,9 +1822,8 @@ package body System.Tasking.Stages is Unlock_RTS; end if; - -- If Self_ID.Master_Within = Self_ID.Master_of_Task + 2 - -- we may have dependent tasks for which we need to wait. - -- Otherwise, we can just exit. + -- If Self_ID.Master_Within = Self_ID.Master_of_Task + 2 we may have + -- dependent tasks for which we need to wait. Otherwise we just exit. if Self_ID.Master_Within = Self_ID.Master_of_Task + 2 then Vulnerable_Complete_Master (Self_ID); @@ -1889,17 +1834,17 @@ package body System.Tasking.Stages is -- Vulnerable_Free_Task -- -------------------------- - -- Recover all runtime system storage associated with the task T. - -- This should only be called after T has terminated and will no - -- longer be referenced. + -- Recover all runtime system storage associated with the task T. This + -- should only be called after T has terminated and will no longer be + -- referenced. - -- For tasks created by an allocator that fails, due to an exception, - -- it is called from Expunge_Unactivated_Tasks. + -- For tasks created by an allocator that fails, due to an exception, it + -- is called from Expunge_Unactivated_Tasks. - -- For tasks created by elaboration of task object declarations it - -- is called from the finalization code of the Task_Wrapper procedure. - -- It is also called from Ada.Unchecked_Deallocation, for objects that - -- are or contain tasks. + -- For tasks created by elaboration of task object declarations it is + -- called from the finalization code of the Task_Wrapper procedure. It is + -- also called from Ada.Unchecked_Deallocation, for objects that are or + -- contain tasks. procedure Vulnerable_Free_Task (T : Task_Id) is begin diff --git a/gcc/ada/s-tassta.ads b/gcc/ada/s-tassta.ads index 03abca42d8b..e96e2d906e7 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -37,14 +37,12 @@ -- Note: Only the compiler is allowed to use this interface, by generating -- direct calls to it, via Rtsfind. + -- Any changes to this interface may require corresponding compiler changes -- in exp_ch9.adb and possibly exp_ch7.adb with System.Task_Info; --- used for Task_Info_Type - with System.Parameters; --- used for Size_Type package System.Tasking.Stages is pragma Elaborate_Body; diff --git a/gcc/ada/s-tasuti.adb b/gcc/ada/s-tasuti.adb index 6767f29c9e5..0706444b480 100644 --- a/gcc/ada/s-tasuti.adb +++ b/gcc/ada/s-tasuti.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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,39 +31,20 @@ -- -- ------------------------------------------------------------------------------ --- This package provides RTS Internal Declarations. +-- This package provides RTS Internal Declarations + -- These declarations are not part of the GNARLI pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. +-- Turn off polling, we do not want ATC polling to take place during tasking +-- operations. It causes infinite loops and other problems. with System.Tasking.Debug; --- used for Known_Tasks - with System.Task_Primitives.Operations; --- used for Write_Lock --- Wakeup --- Unlock --- Sleep --- Abort_Task --- Lock/Unlock_RTS - with System.Tasking.Initialization; --- Used for Defer_Abort --- Undefer_Abort --- Locked_Abort_To_Level - with System.Tasking.Queuing; --- used for Dequeue_Call --- Dequeue_Head - with System.Parameters; --- used for Single_Lock --- Runtime_Traces - with System.Traces.Tasking; --- used for Send_Trace_Info package body System.Tasking.Utilities is @@ -129,8 +110,7 @@ package body System.Tasking.Utilities is if System.Tasking.Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; Initialization.Defer_Abort_Nestable (Self_Id); diff --git a/gcc/ada/s-tataat.adb b/gcc/ada/s-tataat.adb index 1c672769e7f..695f5164ecd 100644 --- a/gcc/ada/s-tataat.adb +++ b/gcc/ada/s-tataat.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, AdaCore -- +-- Copyright (C) 1995-2008, 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,16 +32,10 @@ -- -- ------------------------------------------------------------------------------ -with System.Task_Primitives.Operations; --- used for Write_Lock --- Unlock --- Lock/Unlock_RTS +with Ada.Unchecked_Conversion; +with System.Task_Primitives.Operations; with System.Tasking.Initialization; --- used for Defer_Abort --- Undefer_Abort - -with Ada.Unchecked_Conversion; package body System.Tasking.Task_Attributes is diff --git a/gcc/ada/s-tataat.ads b/gcc/ada/s-tataat.ads index bcf3f0d4c18..43608af448b 100644 --- a/gcc/ada/s-tataat.ads +++ b/gcc/ada/s-tataat.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2007, AdaCore -- +-- Copyright (C) 1995-2008, 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- -- @@ -35,10 +35,8 @@ -- This package provides support for the body of Ada.Task_Attributes with Ada.Finalization; --- Used for Limited_Controlled with System.Storage_Elements; --- Used for Integer_Address package System.Tasking.Task_Attributes is diff --git a/gcc/ada/s-tpoben.adb b/gcc/ada/s-tpoben.adb index b3efad52af1..fd8a16814e8 100644 --- a/gcc/ada/s-tpoben.adb +++ b/gcc/ada/s-tpoben.adb @@ -2,12 +2,11 @@ -- -- -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . -- --- E N T R I E S -- +-- SYSTEM.TASKING.PROTECTED_OBJECTS.ENTRIES -- -- -- --- B o d y -- +-- B o d y -- -- -- --- Copyright (C) 1998-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2008, 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- -- @@ -44,32 +43,13 @@ -- Note: the compiler generates direct calls to this interface, via Rtsfind -with Ada.Exceptions; --- Used for Exception_Occurrence_Access --- Raise_Exception - with System.Task_Primitives.Operations; --- Used for Initialize_Lock --- Write_Lock --- Unlock --- Get_Priority --- Wakeup --- Set_Ceiling +with System.Restrictions; +with System.Parameters; with System.Tasking.Initialization; --- Used for Defer_Abort, --- Undefer_Abort, --- Change_Base_Priority - pragma Elaborate_All (System.Tasking.Initialization); --- This insures that tasking is initialized if any protected objects are --- created. - -with System.Restrictions; --- Used for Abort_Allowed - -with System.Parameters; --- Used for Single_Lock +-- To insure that tasking is initialized if any protected objects are created package body System.Tasking.Protected_Objects.Entries is @@ -77,7 +57,6 @@ package body System.Tasking.Protected_Objects.Entries is use Parameters; use Task_Primitives.Operations; - use Ada.Exceptions; ---------------- -- Local Data -- @@ -126,7 +105,7 @@ package body System.Tasking.Protected_Objects.Entries is STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation); if Ceiling_Violation then - Raise_Exception (Program_Error'Identity, "Ceiling Violation"); + raise Program_Error with "Ceiling Violation"; end if; if Single_Lock then @@ -246,8 +225,7 @@ package body System.Tasking.Protected_Objects.Entries is is begin if Object.Finalized then - Raise_Exception - (Program_Error'Identity, "Protected Object is finalized"); + raise Program_Error with "Protected Object is finalized"; end if; -- If pragma Detect_Blocking is active then, as described in the ARM @@ -306,7 +284,7 @@ package body System.Tasking.Protected_Objects.Entries is Lock_Entries (Object, Ceiling_Violation); if Ceiling_Violation then - Raise_Exception (Program_Error'Identity, "Ceiling Violation"); + raise Program_Error with "Ceiling Violation"; end if; end Lock_Entries; @@ -319,8 +297,7 @@ package body System.Tasking.Protected_Objects.Entries is begin if Object.Finalized then - Raise_Exception - (Program_Error'Identity, "Protected Object is finalized"); + raise Program_Error with "Protected Object is finalized"; end if; -- If pragma Detect_Blocking is active then, as described in the ARM @@ -345,7 +322,7 @@ package body System.Tasking.Protected_Objects.Entries is Read_Lock (Object.L'Access, Ceiling_Violation); if Ceiling_Violation then - Raise_Exception (Program_Error'Identity, "Ceiling Violation"); + raise Program_Error with "Ceiling Violation"; end if; -- We are entering in a protected action, so that we increase the diff --git a/gcc/ada/s-tpoben.ads b/gcc/ada/s-tpoben.ads index d1cc4e7d6f3..afbdc6bac0d 100644 --- a/gcc/ada/s-tpoben.ads +++ b/gcc/ada/s-tpoben.ads @@ -2,12 +2,11 @@ -- -- -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . -- --- E N T R I E S -- +-- SYSTEM.TASKING.PROTECTED_OBJECTS.ENTRIES -- -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -32,11 +31,13 @@ -- -- ------------------------------------------------------------------------------ --- This package contains all the simple primitives related to --- Protected_Objects with entries (i.e init, lock, unlock). +-- This package contains all simple primitives related to Protected_Objects +-- with entries (i.e init, lock, unlock). + -- The handling of protected objects with no entries is done in -- System.Tasking.Protected_Objects, the complex routines for protected -- objects with entries in System.Tasking.Protected_Objects.Operations. + -- The split between Entries and Operations is needed to break circular -- dependencies inside the run time. @@ -44,8 +45,6 @@ -- Any changes to this interface may require corresponding compiler changes. with Ada.Finalization; --- used for Limited_Controlled - with Ada.Unchecked_Conversion; package System.Tasking.Protected_Objects.Entries is diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index f034f9e63a5..7ff99e5e34d 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -2,12 +2,11 @@ -- -- -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . -- --- O P E R A T I O N S -- +-- SYSTEM.TASKING.PROTECTED_OBJECTS.OPERATIONS -- -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2008, 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- -- @@ -32,8 +31,8 @@ -- -- ------------------------------------------------------------------------------ --- This package contains all the extended primitives related to --- Protected_Objects with entries. +-- This package contains all extended primitives related to Protected_Objects +-- with entries. -- The handling of protected objects with no entries is done in -- System.Tasking.Protected_Objects, the simple routines for protected @@ -46,51 +45,18 @@ -- Note: the compiler generates direct calls to this interface, via Rtsfind. with System.Task_Primitives.Operations; --- used for Initialize_Lock --- Write_Lock --- Unlock --- Get_Priority --- Wakeup - with System.Tasking.Entry_Calls; --- used for Wait_For_Completion --- Wait_Until_Abortable --- Wait_For_Completion_With_Timeout - -with System.Tasking.Initialization; --- Used for Defer_Abort, --- Undefer_Abort, --- Change_Base_Priority - -pragma Elaborate_All (System.Tasking.Initialization); --- This insures that tasking is initialized if any protected objects are --- created. - with System.Tasking.Queuing; --- used for Enqueue --- Broadcast_Program_Error --- Select_Protected_Entry_Call --- Onqueue --- Count_Waiting - with System.Tasking.Rendezvous; --- used for Task_Do_Or_Queue - with System.Tasking.Utilities; --- used for Exit_One_ATC_Level - with System.Tasking.Debug; --- used for Trace - with System.Parameters; --- used for Single_Lock --- Runtime_Traces - with System.Traces.Tasking; --- used for Send_Trace_Info - with System.Restrictions; --- used for Run_Time_Restrictions + +with System.Tasking.Initialization; +pragma Elaborate_All (System.Tasking.Initialization); +-- Insures that tasking is initialized if any protected objects are created package body System.Tasking.Protected_Objects.Operations is @@ -580,8 +546,7 @@ package body System.Tasking.Protected_Objects.Operations is end if; if Self_ID.ATC_Nesting_Level = ATC_Level'Last then - Raise_Exception - (Storage_Error'Identity, "not enough ATC nesting levels"); + raise Storage_Error with "not enough ATC nesting levels"; end if; -- If pragma Detect_Blocking is active then Program_Error must be @@ -591,8 +556,7 @@ package body System.Tasking.Protected_Objects.Operations is if Detect_Blocking and then Self_ID.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; -- Self_ID.Deferral_Level should be 0, except when called from Finalize, @@ -981,8 +945,7 @@ package body System.Tasking.Protected_Objects.Operations is begin if Self_Id.ATC_Nesting_Level = ATC_Level'Last then - Raise_Exception (Storage_Error'Identity, - "not enough ATC nesting levels"); + raise Storage_Error with "not enough ATC nesting levels"; end if; -- If pragma Detect_Blocking is active then Program_Error must be @@ -992,8 +955,7 @@ package body System.Tasking.Protected_Objects.Operations is if Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; if Runtime_Traces then diff --git a/gcc/ada/s-tpobop.ads b/gcc/ada/s-tpobop.ads index 0316e0c6564..8620c796f43 100644 --- a/gcc/ada/s-tpobop.ads +++ b/gcc/ada/s-tpobop.ads @@ -2,12 +2,11 @@ -- -- -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . -- --- O P E R A T I O N S -- +-- SYSTEM.TASKING.PROTECTED_OBJECTS.OPERATIONS -- -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -45,7 +44,6 @@ -- Any changes to this interface may require corresponding compiler changes. with Ada.Exceptions; --- Used for Exception_Id with System.Tasking.Protected_Objects.Entries; diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index aeee03684b4..cfa7d3a7e7e 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -2,12 +2,11 @@ -- -- -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . -- --- S I N G L E _ E N T R Y -- +-- SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY -- -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2008, 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,8 +32,8 @@ ------------------------------------------------------------------------------ pragma Style_Checks (All_Checks); --- Turn off subprogram ordering check, since restricted GNARLI --- subprograms are gathered together at end. +-- Turn off subprogram ordering check, since restricted GNARLI subprograms are +-- gathered together at end. -- This package provides an optimized version of Protected_Objects.Operations -- and Protected_Objects.Entries making the following assumptions: @@ -60,19 +59,12 @@ pragma Polling (Off); -- operations. It can cause infinite loops and other problems. pragma Suppress (All_Checks); - -with System.Task_Primitives.Operations; --- used for Self --- Finalize_Lock --- Write_Lock --- Unlock +-- Why is this required ??? with Ada.Exceptions; --- used for Exception_Id --- Raise_Exception +with System.Task_Primitives.Operations; with System.Parameters; --- used for Single_Lock package body System.Tasking.Protected_Objects.Single_Entry is @@ -155,7 +147,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is use type Ada.Exceptions.Exception_Id; E : constant Ada.Exceptions.Exception_Id := - Entry_Call.Exception_To_Raise; + Entry_Call.Exception_To_Raise; begin if E /= Ada.Exceptions.Null_Id then @@ -560,8 +552,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is if Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; Lock_Entry (Object); @@ -686,8 +677,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is if Detect_Blocking and then Self_Id.Common.Protected_Action_Nesting > 0 then - Ada.Exceptions.Raise_Exception - (Program_Error'Identity, "potentially blocking operation"); + raise Program_Error with "potentially blocking operation"; end if; STPO.Write_Lock (Object.L'Access, Ceiling_Violation); diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads index 074ee71e410..f8bf9114409 100644 --- a/gcc/ada/s-tposen.ads +++ b/gcc/ada/s-tposen.ads @@ -2,12 +2,11 @@ -- -- -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S . -- --- S I N G L E _ E N T R Y -- +-- SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY -- -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -35,13 +34,13 @@ -- This package provides an optimized version of Protected_Objects.Operations -- and Protected_Objects.Entries making the following assumptions: -- --- PO have only one entry --- There is only one caller at a time (No_Entry_Queue) --- There is no dynamic priority support (No_Dynamic_Priorities) --- No Abort Statements --- (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0) --- PO are at library level --- None of the tasks will terminate (no need for finalization) +-- PO have only one entry +-- There is only one caller at a time (No_Entry_Queue) +-- There is no dynamic priority support (No_Dynamic_Priorities) +-- No Abort Statements +-- (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0) +-- PO are at library level +-- None of the tasks will terminate (no need for finalization) -- -- This interface is intended to be used in the ravenscar profile, the -- compiler is responsible for ensuring that the conditions mentioned above @@ -268,7 +267,7 @@ package System.Tasking.Protected_Objects.Single_Entry is function Protected_Count_Entry (Object : Protection_Entry) return Natural; - -- Return the number of entry calls on Object (0 or 1). + -- Return the number of entry calls on Object (0 or 1) function Protected_Single_Entry_Caller (Object : Protection_Entry) return Task_Id; diff --git a/gcc/ada/s-valrea.adb b/gcc/ada/s-valrea.adb index 60f48739dab..ead49f80649 100644 --- a/gcc/ada/s-valrea.adb +++ b/gcc/ada/s-valrea.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -56,7 +56,7 @@ package body System.Val_Real is P : Integer; -- Local copy of string pointer - Base : Long_Long_Float; + Base : Long_Long_Float; -- Base value Uval : Long_Long_Float; diff --git a/gcc/ada/s-valuti.adb b/gcc/ada/s-valuti.adb index f2ed3217e2b..50be73acd9f 100644 --- a/gcc/ada/s-valuti.adb +++ b/gcc/ada/s-valuti.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -72,7 +72,6 @@ package body System.Val_Util is S (J) := To_Upper (S (J)); end loop; end if; - end Normalize_String; ------------------- @@ -156,7 +155,6 @@ package body System.Val_Util is Ptr.all := P; return X; - end Scan_Exponent; -------------------- |