Commit 1a49cf99 by Arnaud Charlet

[multiple changes]

2005-03-08  Robert Dewar  <dewar@adacore.com>

	* s-bitops.adb, s-bitops.ads,
	s-taprop-os2.adb, s-intman-vms.ads, s-intman-vxworks.ads,
	s-taprop-vxworks.adb, a-caldel.ads, a-calend.adb, a-tasatt.adb,
	tbuild.ads, s-finimp.adb, s-imgwch.adb, s-intman.ads, s-intman.ads,
	s-memory.adb, s-soflin.ads, s-taasde.ads, s-taprob.adb, s-taprop.ads,
	s-taprop.ads, s-tasini.adb, s-tasini.ads, s-tasini.ads, s-tasini.ads,
	s-taskin.ads, s-tasren.adb, s-tassta.adb, s-tassta.ads, s-tassta.ads,
	s-tasuti.ads, s-tataat.ads, s-tataat.ads, s-tataat.ads, s-tataat.ads,
	s-tpoben.adb, s-tpoben.adb, s-tpobop.ads: Update comments. Minor
	reformatting.

2005-03-08  Eric Botcazou  <ebotcazou@adacore.com>

	* utils2.c (build_binary_op): Fix typo.

2005-03-08  Doug Rupp  <rupp@adacore.com>

	* s-crtl.ads (popen,pclose): New imports.

2005-03-08  Cyrille Comar  <comar@adacore.com>

	* comperr.adb (Compiler_Abort): remove references to obsolete
	procedures in the bug boxes for various GNAT builds.

2005-03-08  Vincent Celier  <celier@adacore.com>

	* snames.ads, snames.adb: Save as Unix text file, not as DOS text file

From-SVN: r96512
parent 728c3084
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-1998, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -39,18 +39,17 @@
package Ada.Calendar.Delays is
procedure Delay_For (D : Duration);
-- Delay until an interval of length (at least) D seconds has passed,
-- or the task is aborted to at least the current ATC nesting level.
-- This is an abort completion point.
-- The body of this procedure must perform all the processing
-- required for an abortion point.
-- Delay until an interval of length (at least) D seconds has passed, or
-- the task is aborted to at least the current ATC nesting level. This is
-- an abort completion point. The body of this procedure must perform all
-- the processing required for an abort point.
procedure Delay_Until (T : Time);
-- Delay until Clock has reached (at least) time T,
-- or the task is aborted to at least the current ATC nesting level.
-- The body of this procedure must perform all the processing
-- required for an abortion point.
-- Delay until Clock has reached (at least) time T, or the task is aborted
-- to at least the current ATC nesting level. The body of this procedure
-- must perform all the processing required for an abort point.
function To_Duration (T : Time) return Duration;
-- Convert Time to Duration
end Ada.Calendar.Delays;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -20,7 +20,7 @@
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- Extensive contributions were provided by AdaCore. --
-- --
------------------------------------------------------------------------------
......@@ -78,7 +78,7 @@ package body Comperr is
-- the cause of the compiler abort and about the preferred method
-- of reporting bugs. The default is a bug box appropriate for
-- the FSF version of GNAT, but there are specializations for
-- the GNATPRO and Public releases by Ada Core Technologies.
-- the GNATPRO and Public releases by AdaCore.
procedure End_Line;
-- Add blanks up to column 76, and then a final vertical bar
......@@ -95,7 +95,6 @@ package body Comperr is
Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
Is_GAP_Version : constant Boolean := Get_Gnat_Build_Type = GAP;
-- Start of processing for Compiler_Abort
......@@ -268,72 +267,67 @@ package body Comperr is
" http://gcc.gnu.org/bugs.html.");
End_Line;
else
elsif Is_Public_Version then
Write_Str
("| Please submit bug report by email " &
"to report@gnat.com.");
("| submit bug report by email " &
"to report@adacore.com.");
End_Line;
Write_Str
("| Use a subject line meaningful to you" &
" and us to track the bug.");
("| See gnatinfo.txt for full info on procedure " &
"for submitting bugs.");
End_Line;
end if;
if not (Is_Public_Version or Is_FSF_Version) then
else
Write_Str
("| (include your customer number #nnn " &
"in the subject line).");
("| Please submit a bug report using GNAT Tracker:");
End_Line;
end if;
Write_Str
("| Include the entire contents of this bug " &
"box in the report.");
("| http://www.adacore.com/gnattracker/ " &
"section 'send a report'.");
End_Line;
Write_Str
("| Include the exact gcc or gnatmake command " &
"that you entered.");
("| alternatively submit a bug report by email " &
"to report@adacore.com.");
End_Line;
end if;
Write_Str
("| Also include sources listed below in gnatchop format");
End_Line;
Write_Str
("| (concatenated together with no headers between files).");
("| Use a subject line meaningful to you" &
" and us to track the bug.");
End_Line;
if Is_Public_Version then
if not (Is_Public_Version or Is_FSF_Version) then
Write_Str
("| (use plain ASCII or MIME attachment).");
("| Include your customer number #nnn " &
"in the subject line.");
End_Line;
end if;
Write_Str
("| See gnatinfo.txt for full info on procedure " &
"for submitting bugs.");
("| Include the entire contents of this bug " &
"box in the report.");
End_Line;
elsif Is_GAP_Version then
Write_Str
("| (use plain ASCII or MIME attachment, or FTP "
& "to your GAP account.).");
("| Include the exact gcc or gnatmake command " &
"that you entered.");
End_Line;
Write_Str
("| Please use your GAP account to report this.");
("| Also include sources listed below in gnatchop format");
End_Line;
elsif not Is_FSF_Version then
Write_Str
("| (use plain ASCII or MIME attachment, or FTP "
& "to your customer directory).");
("| (concatenated together with no headers between files).");
End_Line;
if not Is_FSF_Version then
Write_Str
("| See README.GNATPRO for full info on procedure " &
"for submitting bugs.");
("| Use plain ASCII or MIME attachment.");
End_Line;
end if;
end if;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -107,8 +107,7 @@ package body System.Bit_Ops is
(Left : Address;
Llen : Natural;
Right : Address;
Rlen : Natural)
return Boolean
Rlen : Natural) return Boolean
is
LeftB : constant Bits := To_Bits (Left);
RightB : constant Bits := To_Bits (Right);
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -40,7 +40,8 @@ package System.Bit_Ops is
-- Note: in all the following routines, the System.Address parameters
-- represent the address of the first byte of an array used to represent
-- a packed array (of type System.Unsigned_Types.Packed_Bytes{1,2,4})
-- The length in bits is passed as a separate parameter.
-- The length in bits is passed as a separate parameter. Note that all
-- addresses must be of byte aligned arrays.
procedure Bit_And
(Left : System.Address;
......@@ -57,8 +58,7 @@ package System.Bit_Ops is
(Left : System.Address;
Llen : Natural;
Right : System.Address;
Rlen : Natural)
return Boolean;
Rlen : Natural) return Boolean;
-- Left and Right are the addresses of two bit packed arrays with Llen
-- and Rlen being the respective length in bits. The routine compares the
-- two bit strings for equality, being careful not to include the unused
......
......@@ -139,6 +139,12 @@ pragma Preelaborate (CRTL);
function opendir (file_name : String) return DIRs;
pragma Import (C, opendir, "opendir");
function pclose (stream : System.Address) return int;
pragma Import (C, pclose, "pclose");
function popen (command, mode : System.Address) return System.Address;
pragma Import (C, popen, "popen");
function read (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, read, "read");
......
......@@ -383,19 +383,22 @@ package body System.Finalization_Implementation is
procedure Finalize_Global_List is
begin
-- There are three case here:
-- a. the application uses tasks, in which case Finalize_Global_Tasks
-- will defer abortion
-- will defer abort.
-- b. the application doesn't use tasks but uses other tasking
-- constructs, such as ATCs and protected objects. In this case,
-- the binder will call Finalize_Global_List instead of
-- Finalize_Global_Tasks, letting abort undeferred, and leading
-- to assertion failures in the GNULL
-- c. the application doesn't use any tasking construct in which case
-- deferring abort isn't necessary.
--
-- Until another solution is found to deal with case b, we need to
-- call abort_defer here to pass the checks, but we do not need to
-- undefer abortion, since Finalize_Global_List is the last procedure
-- undefer abort, since Finalize_Global_List is the last procedure
-- called before exiting the partition.
SSL.Abort_Defer.all;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,30 +31,31 @@
-- --
------------------------------------------------------------------------------
-- This is the Alpha/VMS version of this package.
--
-- This package encapsulates and centralizes information about
-- all uses of interrupts (or signals), including the
-- target-dependent mapping of interrupts (or signals) to exceptions.
-- This is the Alpha/VMS version of this package
-- PLEASE DO NOT add any with-clauses to this package.
-- This is designed to work for both tasking and non-tasking systems,
-- without pulling in any of the tasking support.
-- This package encapsulates and centralizes information about all uses of
-- interrupts (or signals), including the target-dependent mapping of
-- interrupts (or signals) to exceptions.
-- PLEASE DO NOT add any with-clauses to this package
-- This is designed to work for both tasking and non-tasking systems, without
-- pulling in any of the tasking support.
-- PLEASE DO NOT remove the Elaborate_Body pragma from this package.
-- Elaboration of this package should happen early, as most other
-- initializations depend on it.
-- Forcing immediate elaboration of the body also helps to enforce
-- the design assumption that this is a second-level
-- package, just one level above System.OS_Interface, with no
-- cross-dependences.
-- PLEASE DO NOT put any subprogram declarations with arguments of
-- type Interrupt_ID into the visible part of this package.
-- The type Interrupt_ID is used to derive the type in Ada.Interrupts,
-- and adding more operations to that type would be illegal according
-- to the Ada Reference Manual. (This is the reason why the signals sets
-- below are implemented as visible arrays rather than functions.)
-- Forcing immediate elaboration of the body also helps to enforce the design
-- assumption that this is a second-level package, just one level above
-- System.OS_Interface, with no cross-dependences.
-- PLEASE DO NOT put any subprogram declarations with arguments of type
-- Interrupt_ID into the visible part of this package.
-- The type Interrupt_ID is used to derive the type in Ada.Interrupts, and
-- adding more operations to that type would be illegal according to the Ada
-- Reference Manual. (This is the reason why the signals sets below are
-- implemented as visible arrays rather than functions.)
with System.OS_Interface;
-- used for Signal
......@@ -70,49 +71,44 @@ package System.Interrupt_Management is
type Interrupt_Set is array (Interrupt_ID) of Boolean;
-- The following objects serve as constants, but are initialized
-- in the body to aid portability. This permits us
-- to use more portable names for interrupts,
-- where distinct names may map to the same interrupt ID value.
-- For example, suppose SIGRARE is a signal that is not defined on
-- all systems, but is always reserved when it is defined.
-- If we have the convention that ID zero is not used for any "real"
-- signals, and SIGRARE = 0 when SIGRARE is not one of the locally
-- supported signals, we can write
-- The following objects serve as constants, but are initialized in the
-- body to aid portability. This permits us to use more portable names for
-- interrupts, where distinct names may map to the same interrupt ID
-- value. For example, suppose SIGRARE is a signal that is not defined on
-- all systems, but is always reserved when it is defined. If we have the
-- convention that ID zero is not used for any "real" signals, and SIGRARE
-- = 0 when SIGRARE is not one of the locally supported signals, we can
-- write
-- Reserved (SIGRARE) := true;
-- and the initialization code will be portable.
-- Then the initialization code will be portable
Abort_Task_Interrupt : Interrupt_ID;
-- The interrupt that is used to implement task abortion,
-- if an interrupt is used for that purpose.
-- This is one of the reserved interrupts.
-- The interrupt that is used to implement task abort, if an interrupt is
-- used for that purpose. This is one of the reserved interrupts.
Keep_Unmasked : Interrupt_Set := (others => False);
-- Keep_Unmasked (I) is true iff the interrupt I is
-- one that must be kept unmasked at all times,
-- except (perhaps) for short critical sections.
-- This includes interrupts that are mapped to exceptions
-- (see System.Interrupt_Exceptions.Is_Exception), but may also
-- include interrupts (e.g. timer) that need to be kept unmasked
-- for other reasons.
-- Where interrupts are implemented as OS signals, and signal masking
-- is per-task, the interrupt should be unmasked in ALL TASKS.
-- Keep_Unmasked (I) is true iff the interrupt I is one that must be kept
-- unmasked at all times, except (perhaps) for short critical sections.
-- This includes interrupts that are mapped to exceptions (see
-- System.Interrupt_Exceptions.Is_Exception), but may also include
-- interrupts (e.g. timer) that need to be kept unmasked for other
-- reasons. Where interrupts are implemented as OS signals, and signal
-- masking is per-task, the interrupt should be unmasked in ALL TASKS.
Reserve : Interrupt_Set := (others => False);
-- Reserve (I) is true iff the interrupt I is one that
-- cannot be permitted to be attached to a user handler.
-- The possible reasons are many. For example,
-- it may be mapped to an exception, used to implement task abortion,
-- or used to implement time delays.
-- Reserve (I) is true iff the interrupt I is one that cannot be permitted
-- to be attached to a user handler. The possible reasons are many. For
-- example it may be mapped to an exception used to implement task abort.
Keep_Masked : Interrupt_Set := (others => False);
-- Keep_Masked (I) is true iff the interrupt I must always be masked.
-- Where interrupts are implemented as OS signals, and signal masking
-- is per-task, the interrupt should be masked in ALL TASKS.
-- There might not be any interrupts in this class, depending on
-- the environment. For example, if interrupts are OS signals
-- and signal masking is per-task, use of the sigwait operation
-- requires the signal be masked in all tasks.
-- Where interrupts are implemented as OS signals, and signal masking is
-- per-task, the interrupt should be masked in ALL TASKS. There might not
-- be any interrupts in this class, depending on the environment. For
-- example, if interrupts are OS signals and signal masking is per-task,
-- use of the sigwait operation requires the signal be masked in all tasks.
procedure Initialize_Interrupts;
-- On systems where there is no signal inheritance between tasks (e.g
......@@ -121,7 +117,6 @@ package System.Interrupt_Management is
-- only be called by initialize in this package body.
private
use type System.OS_Interface.unsigned_long;
type Interrupt_Mask is new System.OS_Interface.sigset_t;
......@@ -136,7 +131,7 @@ private
Rcv_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
Snd_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
Interrupt_Mailbox : Interrupt_ID := 0;
Interrupt_Bufquo : System.OS_Interface.unsigned_long
:= 1000 * (Interrupt_ID'Size / 8);
Interrupt_Bufquo : System.OS_Interface.unsigned_long :=
1000 * (Interrupt_ID'Size / 8);
end System.Interrupt_Management;
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This is the VxWorks version of this package.
-- This is the VxWorks version of this package
-- This package encapsulates and centralizes information about all
-- uses of interrupts (or signals), including the target-dependent
......@@ -76,48 +76,48 @@ package System.Interrupt_Management is
type Signal_Set is array (Signal_ID) of Boolean;
-- The following objects serve as constants, but are initialized
-- in the body to aid portability. This permits us to use more
-- portable names for interrupts, where distinct names may map to
-- the same interrupt ID value.
--
-- For example, suppose SIGRARE is a signal that is not defined on
-- all systems, but is always reserved when it is defined. If we
-- have the convention that ID zero is not used for any "real"
-- signals, and SIGRARE = 0 when SIGRARE is not one of the locally
-- supported signals, we can write
-- The following objects serve as constants, but are initialized in the
-- body to aid portability. This permits us to use more portable names for
-- interrupts, where distinct names may map to the same interrupt ID
-- value.
-- For example, suppose SIGRARE is a signal that is not defined on all
-- systems, but is always reserved when it is defined. If we have the
-- convention that ID zero is not used for any "real" signals, and SIGRARE
-- = 0 when SIGRARE is not one of the locally supported signals, we can
-- write:
-- Reserved (SIGRARE) := true;
-- and the initialization code will be portable.
Abort_Task_Signal : Signal_ID;
-- The signal that is used to implement task abortion if
-- an interrupt is used for that purpose. This is one of the
-- reserved signals.
-- The signal that is used to implement task abort if an interrupt is used
-- for that purpose. This is one of the reserved signals.
Keep_Unmasked : Signal_Set := (others => False);
-- Keep_Unmasked (I) is true iff the signal I is one that must
-- that must be kept unmasked at all times, except (perhaps) for
-- short critical sections. This includes signals that are
-- mapped to exceptions, but may also include interrupts
-- (e.g. timer) that need to be kept unmasked for other
-- reasons. Where signal masking is per-task, the signal should be
-- Keep_Unmasked (I) is true iff the signal I is one that must that must
-- be kept unmasked at all times, except (perhaps) for short critical
-- sections. This includes signals that are mapped to exceptions, but may
-- also include interrupts (e.g. timer) that need to be kept unmasked for
-- other reasons. Where signal masking is per-task, the signal should be
-- unmasked in ALL TASKS.
Reserve : Interrupt_Set := (others => False);
-- Reserve (I) is true iff the interrupt I is one that cannot be
-- permitted to be attached to a user handler. The possible reasons
-- are many. For example, it may be mapped to an exception used to
-- implement task abortion, or used to implement time delays.
-- Reserve (I) is true iff the interrupt I is one that cannot be permitted
-- to be attached to a user handler. The possible reasons are many. For
-- example, it may be mapped to an exception used to implement task abort,
-- or used to implement time delays.
procedure Initialize_Interrupts;
-- On systems where there is no signal inheritance between tasks (e.g
-- VxWorks, GNU/LinuxThreads), this procedure is used to initialize
-- interrupts handling in each task. Otherwise this function should
-- only be called by initialize in this package body.
-- interrupts handling in each task. Otherwise this function should only
-- be called by initialize in this package body.
private
type Interrupt_Mask is new System.OS_Interface.sigset_t;
-- In some implementation Interrupt_Mask can be represented
-- as a linked list.
-- In some implementation Interrupt_Mask can be represented as a linked
-- list.
end System.Interrupt_Management;
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,26 +31,26 @@
-- --
------------------------------------------------------------------------------
-- This package encapsulates and centralizes information about all
-- uses of interrupts (or signals), including the target-dependent
-- mapping of interrupts (or signals) to exceptions.
-- This package encapsulates and centralizes information about all uses of
-- interrupts (or signals), including the target-dependent mapping of
-- interrupts (or signals) to exceptions.
-- Unlike the original design, System.Interrupt_Management can only
-- be used for tasking systems.
-- Unlike the original design, System.Interrupt_Management can only be used
-- for tasking systems.
-- PLEASE DO NOT remove the Elaborate_Body pragma from this package.
-- Elaboration of this package should happen early, as most other
-- initializations depend on it. Forcing immediate elaboration of
-- the body also helps to enforce the design assumption that this
-- is a second-level package, just one level above System.OS_Interface
-- with no cross-dependencies.
-- PLEASE DO NOT put any subprogram declarations with arguments of
-- type Interrupt_ID into the visible part of this package. The type
-- Interrupt_ID is used to derive the type in Ada.Interrupts, and
-- adding more operations to that type would be illegal according
-- to the Ada Reference Manual. This is the reason why the signals
-- sets are implemeneted using visible arrays rather than functions.
-- initializations depend on it. Forcing immediate elaboration of the body
-- also helps to enforce the design assumption that this is a second-level
-- package, just one level above System.OS_Interface with no
-- cross-dependencies.
-- PLEASE DO NOT put any subprogram declarations with arguments of type
-- Interrupt_ID into the visible part of this package. The type Interrupt_ID
-- is used to derive the type in Ada.Interrupts, and adding more operations
-- to that type would be illegal according to the Ada Reference Manual. This
-- is the reason why the signals sets are implemeneted using visible arrays
-- rather than functions.
with System.OS_Interface;
-- used for sigset_t
......@@ -69,49 +69,49 @@ package System.Interrupt_Management is
type Interrupt_Set is array (Interrupt_ID) of Boolean;
-- The following objects serve as constants, but are initialized
-- in the body to aid portability. This permits us to use more
-- portable names for interrupts, where distinct names may map to
-- the same interrupt ID value.
--
-- For example, suppose SIGRARE is a signal that is not defined on
-- all systems, but is always reserved when it is defined. If we
-- have the convention that ID zero is not used for any "real"
-- signals, and SIGRARE = 0 when SIGRARE is not one of the locally
-- supported signals, we can write
-- Reserved (SIGRARE) := true;
-- The following objects serve as constants, but are initialized in the
-- body to aid portability. This permits us to use more portable names for
-- interrupts, where distinct names may map to the same interrupt ID
-- value.
-- For example, suppose SIGRARE is a signal that is not defined on all
-- systems, but is always reserved when it is defined. If we have the
-- convention that ID zero is not used for any "real" signals, and SIGRARE
-- = 0 when SIGRARE is not one of the locally supported signals, we can
-- write
-- Reserved (SIGRARE) := True;
-- and the initialization code will be portable.
Abort_Task_Interrupt : Interrupt_ID;
-- The interrupt that is used to implement task abortion if
-- an interrupt is used for that purpose. This is one of the
-- reserved interrupts.
-- The interrupt that is used to implement task abort if an interrupt is
-- used for that purpose. This is one of the reserved interrupts.
Keep_Unmasked : Interrupt_Set := (others => False);
-- Keep_Unmasked (I) is true iff the interrupt I is one that must
-- that must be kept unmasked at all times, except (perhaps) for
-- short critical sections. This includes interrupts that are
-- mapped to exceptions (see System.Interrupt_Exceptions.Is_Exception),
-- but may also include interrupts (e.g. timer) that need to be kept
-- unmasked for other reasons. Where interrupts are implemented as
-- OS signals, and signal masking is per-task, the interrupt should
-- be unmasked in ALL TASKS.
-- Keep_Unmasked (I) is true iff the interrupt I is one that must that
-- must be kept unmasked at all times, except (perhaps) for short critical
-- sections. This includes interrupts that are mapped to exceptions (see
-- System.Interrupt_Exceptions.Is_Exception), but may also include
-- interrupts (e.g. timer) that need to be kept unmasked for other
-- reasons. Where interrupts are implemented as OS signals, and signal
-- masking is per-task, the interrupt should be unmasked in ALL TASKS.
Reserve : Interrupt_Set := (others => False);
-- Reserve (I) is true iff the interrupt I is one that cannot be
-- permitted to be attached to a user handler. The possible reasons
-- are many. For example, it may be mapped to an exception used to
-- implement task abortion, or used to implement time delays.
-- Reserve (I) is true iff the interrupt I is one that cannot be permitted
-- to be attached to a user handler. The possible reasons are many. For
-- example, it may be mapped to an exception used to implement task abort,
-- or used to implement time delays.
procedure Initialize_Interrupts;
-- On systems where there is no signal inheritance between tasks (e.g
-- VxWorks, GNU/LinuxThreads), this procedure is used to initialize
-- interrupts handling in each task. Otherwise this function should
-- only be called by initialize in this package body.
-- interrupts handling in each task. Otherwise this function should only
-- be called by initialize in this package body.
private
type Interrupt_Mask is new System.OS_Interface.sigset_t;
-- In some implementation Interrupt_Mask can be represented
-- as a linked list.
-- In some implementations Interrupt_Mask can be represented as a linked
-- list.
end System.Interrupt_Management;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -35,13 +35,13 @@
-- This implementation assumes that the underlying malloc/free/realloc
-- implementation is thread safe, and thus, no additional lock is required.
-- Note that we still need to defer abortion because on most systems,
-- an asynchronous signal (as used for implementing asynchronous abortion
-- of task) cannot safely be handled while malloc is executing.
-- Note that we still need to defer abort because on most systems, an
-- asynchronous signal (as used for implementing asynchronous abort of
-- task) cannot safely be handled while malloc is executing.
-- If you are not using Ada constructs containing the "abort" keyword,
-- then you can remove the calls to Abort_Defer.all and Abort_Undefer.all
-- from this unit.
-- If you are not using Ada constructs containing the "abort" keyword, then
-- you can remove the calls to Abort_Defer.all and Abort_Undefer.all from
-- this unit.
with Ada.Exceptions;
with System.Soft_Links;
......
......@@ -52,7 +52,7 @@ package System.Soft_Links is
pragma Import
(Ada, Current_Target_Exception,
"__gnat_current_target_exception");
-- Import this subprogram from the private part of Ada.Exceptions.
-- Import this subprogram from the private part of Ada.Exceptions
-- First we have the access subprogram types used to establish the links.
-- The approach is to establish variables containing access subprogram
......@@ -112,20 +112,20 @@ package System.Soft_Links is
-- Declarations for the no tasking versions of the required routines
procedure Abort_Defer_NT;
-- Defer task abortion (non-tasking case, does nothing)
-- Defer task abort (non-tasking case, does nothing)
procedure Abort_Undefer_NT;
-- Undefer task abortion (non-tasking case, does nothing)
-- Undefer task abort (non-tasking case, does nothing)
procedure Abort_Handler_NT;
-- Handle task abortion (non-tasking case, does nothing). Currently,
-- only VMS uses this.
-- Handle task abort (non-tasking case, does nothing). Currently, only VMS
-- uses this.
procedure Update_Exception_NT (X : EO := Current_Target_Exception);
-- Handle exception setting. This routine is provided for targets
-- which have built-in exception handling such as the Java Virtual
-- Machine. Currently, only JGNAT uses this. See 4jexcept.ads for
-- an explanation on how this routine is used.
-- Handle exception setting. This routine is provided for targets which
-- have built-in exception handling such as the Java Virtual Machine.
-- Currently, only JGNAT uses this. See 4jexcept.ads for an explanation on
-- how this routine is used.
function Check_Abort_Status_NT return Integer;
-- Returns Boolean'Pos (True) iff abort signal should raise
......@@ -143,14 +143,14 @@ package System.Soft_Links is
Abort_Defer : No_Param_Proc := Abort_Defer_NT'Access;
pragma Suppress (Access_Check, Abort_Defer);
-- Defer task abortion (task/non-task case as appropriate)
-- Defer task abort (task/non-task case as appropriate)
Abort_Undefer : No_Param_Proc := Abort_Undefer_NT'Access;
pragma Suppress (Access_Check, Abort_Undefer);
-- Undefer task abortion (task/non-task case as appropriate)
-- Undefer task abort (task/non-task case as appropriate)
Abort_Handler : No_Param_Proc := Abort_Handler_NT'Access;
-- Handle task abortion (task/non-task case as appropriate)
-- Handle task abort (task/non-task case as appropriate)
Update_Exception : Special_EO_Call := Update_Exception_NT'Access;
-- Handle exception setting and tasking polling when appropriate
......@@ -196,7 +196,7 @@ package System.Soft_Links is
-- explicitly or implicitly during the critical locked region.
Adafinal : No_Param_Proc := Null_Adafinal'Access;
-- Performs the finalization of the Ada Runtime.
-- Performs the finalization of the Ada Runtime
function Get_Jmpbuf_Address_NT return Address;
procedure Set_Jmpbuf_Address_NT (Addr : Address);
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,8 +31,8 @@
-- --
------------------------------------------------------------------------------
-- This package contains the procedures to implements timeouts (delays)
-- for asynchronous select statements.
-- This package contains the procedures to implements timeouts (delays) for
-- asynchronous select statements.
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes.
......@@ -100,8 +100,8 @@ package System.Tasking.Async_Delays is
(T : in Duration;
D : Delay_Block_Access) return Boolean;
-- Enqueue the specified relative delay. Returns True if the delay has
-- been enqueued, False if it has already expired.
-- If the delay has been enqueued, abortion is deferred.
-- been enqueued, False if it has already expired. If the delay has been
-- enqueued, abort is deferred.
procedure Cancel_Async_Delay (D : Delay_Block_Access);
-- Cancel the specified asynchronous delay
......
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Ada Core Technologies --
-- Copyright (C) 1995-2005, Ada Core Technologies --
-- --
-- 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- --
......@@ -90,15 +90,15 @@ package body System.Tasking.Protected_Objects is
Ceiling_Violation : Boolean;
begin
-- The lock is made without defering abortion.
-- The lock is made without defering abort
-- Therefore the abortion has to be deferred before calling this
-- routine. This means that the compiler has to generate a Defer_Abort
-- call before the call to Lock.
-- Therefore the abort has to be deferred before calling this routine.
-- This means that the compiler has to generate a Defer_Abort call
-- before the call to Lock.
-- The caller is responsible for undeferring abortion, and compiler
-- The caller is responsible for undeferring abort, and compiler
-- generated calls must be protected with cleanup handlers to ensure
-- that abortion is undeferred in all cases.
-- that abort is undeferred in all cases.
Write_Lock (Object.L'Access, Ceiling_Violation);
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -112,7 +112,7 @@ package body System.Task_Primitives.Operations is
-- Local Data --
-----------------
-- The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr.
-- The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr
-- This API reserves a small range of virtual addresses that is backed
-- by different physical memory for each running thread. In this case we
......@@ -141,7 +141,7 @@ package body System.Task_Primitives.Operations is
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task.
-- A variable to hold Task_Id for the environment task
-----------------------
-- Local Subprograms --
......@@ -223,7 +223,7 @@ package body System.Task_Primitives.Operations is
Self_ID : Task_Id renames Thread_Local_Data_Ptr.Self_ID;
begin
-- Check that the thread local data has been initialized.
-- Check that the thread local data has been initialized
pragma Assert
((Thread_Local_Data_Ptr /= null
......@@ -458,7 +458,7 @@ package body System.Task_Primitives.Operations is
Count : aliased ULONG; -- Used to store dummy result
begin
-- Must reset Cond BEFORE L is unlocked.
-- Must reset Cond BEFORE L is unlocked
Sem_Must_Not_Fail
(DosResetEventSem (Self_ID.Common.LL.CV, Count'Unchecked_Access));
......@@ -475,7 +475,7 @@ package body System.Task_Primitives.Operations is
Sem_Must_Not_Fail
(DosWaitEventSem (Self_ID.Common.LL.CV, SEM_INDEFINITE_WAIT));
-- Since L was previously accquired, lock operation should not fail.
-- Since L was previously accquired, lock operation should not fail
if Single_Lock then
Lock_RTS;
......@@ -516,7 +516,7 @@ package body System.Task_Primitives.Operations is
Count : aliased ULONG; -- Used to store dummy result
begin
-- Must reset Cond BEFORE Self_ID is unlocked.
-- Must reset Cond BEFORE Self_ID is unlocked
Sem_Must_Not_Fail
(DosResetEventSem (Self_ID.Common.LL.CV,
......@@ -611,7 +611,7 @@ package body System.Task_Primitives.Operations is
Write_Lock (Self_ID);
end if;
-- Must reset Cond BEFORE Self_ID is unlocked.
-- Must reset Cond BEFORE Self_ID is unlocked
Sem_Must_Not_Fail
(DosResetEventSem (Self_ID.Common.LL.CV,
......@@ -767,7 +767,7 @@ package body System.Task_Primitives.Operations is
procedure Enter_Task (Self_ID : Task_Id) is
begin
-- Initialize thread local data. Must be done first.
-- Initialize thread local data. Must be done first
Thread_Local_Data_Ptr.Self_ID := Self_ID;
Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
......@@ -927,7 +927,7 @@ package body System.Task_Primitives.Operations is
T.Common.LL.Wrapper := To_PFNTHREAD (Wrapper);
-- The OS implicitly gives the new task the priority of this task.
-- The OS implicitly gives the new task the priority of this task
T.Common.LL.Current_Priority := Self.Common.LL.Current_Priority;
......@@ -1007,7 +1007,7 @@ package body System.Task_Primitives.Operations is
begin
null;
-- Task abortion not implemented yet.
-- Task abort not implemented yet.
-- Should perform other action ???
end Abort_Task;
......@@ -1103,9 +1103,9 @@ package body System.Task_Primitives.Operations is
Environment_Task_Id := Environment_Task;
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
-- Initialize the lock used to synchronize chain of all ATCBs.
-- Initialize the lock used to synchronize chain of all ATCBs
-- Set ID of environment task.
-- Set ID of environment task
Thread_Local_Data_Ptr.Self_ID := Environment_Task;
Environment_Task.Common.LL.Thread := 1; -- By definition
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -41,30 +41,30 @@ pragma Polling (Off);
-- to poll it can cause infinite loops.
with Ada.Exceptions;
-- used for Exception_Occurrence_Access.
-- Used for Exception_Occurrence_Access
with System.Tasking;
pragma Elaborate_All (System.Tasking);
-- ensure that the first step initializations have been performed
-- Ensure that the first step initializations have been performed
with System.Task_Primitives;
-- used for Lock
-- Used for Lock
with System.Task_Primitives.Operations;
-- used for Set_Priority
-- 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.
-- 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
-- Used for Trace
with System.Stack_Checking;
......@@ -88,7 +88,7 @@ package body System.Tasking.Initialization is
function Current_Target_Exception return AE.Exception_Occurrence;
pragma Import
(Ada, Current_Target_Exception, "__gnat_current_target_exception");
-- Import this subprogram from the private part of Ada.Exceptions.
-- Import this subprogram from the private part of Ada.Exceptions
----------------------------------------------------------------------
-- Tasking versions of some services needed by non-tasking programs --
......@@ -150,7 +150,7 @@ package body System.Tasking.Initialization is
-- Change_Base_Priority --
--------------------------
-- Call only with abort deferred and holding Self_ID locked.
-- Call only with abort deferred and holding Self_ID locked
procedure Change_Base_Priority (T : Task_Id) is
begin
......@@ -269,7 +269,7 @@ package body System.Tasking.Initialization is
-- while we had abort deferred below.
loop
-- Temporarily defer abortion so that we can lock Self_ID.
-- Temporarily defer abort so that we can lock Self_ID
Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
......@@ -286,7 +286,7 @@ package body System.Tasking.Initialization is
Unlock_RTS;
end if;
-- Restore the original Deferral value.
-- Restore the original Deferral value
Self_ID.Deferral_Level := Self_ID.Deferral_Level - 1;
......@@ -401,11 +401,11 @@ package body System.Tasking.Initialization is
SSL.Tasking.Init_Tasking_Soft_Links;
-- Install tasking locks in the GCC runtime.
-- Install tasking locks in the GCC runtime
Gnat_Install_Locks (Task_Lock'Access, Task_Unlock'Access);
-- Abortion is deferred in a new ATCB, so we need to undefer abortion
-- Abort is deferred in a new ATCB, so we need to undefer abort
-- at this stage to make the environment task abortable.
Undefer_Abort (Environment_Task);
......@@ -426,15 +426,16 @@ package body System.Tasking.Initialization is
-- hurt to uncomment the above call, until the error is corrected for
-- all targets.
-- See extended comments in package body System.Tasking.Abortion
-- for the overall design of the implementation of task abort.
-- See extended comments in package body System.Tasking.Abort for the
-- overall design of the implementation of task abort.
-- ??? there is no such package ???
-- If the task is sleeping it will be in an abort-deferred region,
-- and will not have Abort_Signal raised by Abort_Task.
-- Such an "abort deferral" is just to protect the RTS internals,
-- and not necessarily required to enforce Ada semantics.
-- Abort_Task should wake the task up and let it decide if it wants
-- to complete the aborted construct immediately.
-- If the task is sleeping it will be in an abort-deferred region, and
-- will not have Abort_Signal raised by Abort_Task. Such an "abort
-- deferral" is just to protect the RTS internals, and not necessarily
-- required to enforce Ada semantics. Abort_Task should wake the task up
-- and let it decide if it wants to complete the aborted construct
-- immediately.
-- Note that the effect of the lowl-level Abort_Task is not persistent.
-- If the target task is not blocked, this wakeup will be missed.
......@@ -452,14 +453,13 @@ package body System.Tasking.Initialization is
-- implement delays). That still left the possibility of missed
-- wakeups.
-- We cannot safely call Vulnerable_Complete_Activation here,
-- since that requires locking Self_ID.Parent. The anti-deadlock
-- lock ordering rules would then require us to release the lock
-- on Self_ID first, which would create a timing window for other
-- tasks to lock Self_ID. This is significant for tasks that may be
-- aborted before their execution can enter the task body, and so
-- they do not get a chance to call Complete_Task. The actual work
-- for this case is done in Terminate_Task.
-- We cannot safely call Vulnerable_Complete_Activation here, since that
-- requires locking Self_ID.Parent. The anti-deadlock lock ordering rules
-- would then require us to release the lock on Self_ID first, which would
-- create a timing window for other tasks to lock Self_ID. This is
-- significant for tasks that may be aborted before their execution can
-- enter the task body, and so they do not get a chance to call
-- Complete_Task. The actual work for this case is done in Terminate_Task.
procedure Locked_Abort_To_Level
(Self_ID : Task_Id;
......@@ -694,12 +694,12 @@ package body System.Tasking.Initialization is
-- Precondition : Self does not hold any locks!
-- Undefer_Abort is called on any abortion completion point (aka.
-- Undefer_Abort is called on any abort completion point (aka.
-- synchronization point). It performs the following actions if they
-- are pending: (1) change the base priority, (2) abort the task.
-- The priority change has to occur before abortion. Otherwise, it would
-- take effect no earlier than the next abortion completion point.
-- The priority change has to occur before abort. Otherwise, it would
-- take effect no earlier than the next abort completion point.
procedure Undefer_Abort (Self_ID : Task_Id) is
begin
......@@ -761,8 +761,8 @@ package body System.Tasking.Initialization is
-- Undefer_Abortion --
----------------------
-- Phase out RTS-internal use of Undefer_Abortion
-- to reduce overhead due to multiple calls to Self.
-- Phase out RTS-internal use of Undefer_Abortion to reduce overhead due
-- to multiple calls to Self.
procedure Undefer_Abortion is
Self_ID : Task_Id;
......@@ -806,7 +806,7 @@ package body System.Tasking.Initialization is
-- Update_Exception --
----------------------
-- Call only when holding no locks.
-- Call only when holding no locks
procedure Update_Exception
(X : AE.Exception_Occurrence := Current_Target_Exception)
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -37,8 +37,7 @@
package System.Tasking.Initialization is
procedure Remove_From_All_Tasks_List (T : Task_Id);
-- Remove T from All_Tasks_List.
-- Call this function with RTS_Lock taken.
-- Remove T from All_Tasks_List. Call this function with RTS_Lock taken
---------------------------------
-- Tasking-Specific Soft Links --
......@@ -47,7 +46,8 @@ package System.Tasking.Initialization is
-- These permit us to leave out certain portions of the tasking
-- run-time system if they are not used. They are only used internally
-- by the tasking run-time system.
-- So far, the only example is support for Ada.Task_Attributes.
-- So far, the only example is support for Ada.Task_Attributes
type Proc_T is access procedure (T : Task_Id);
......@@ -55,10 +55,10 @@ package System.Tasking.Initialization is
procedure Initialize_Attributes (T : Task_Id);
Finalize_Attributes_Link : Proc_T := Finalize_Attributes'Access;
-- should be called with abortion deferred and T.L write-locked
-- should be called with abort deferred and T.L write-locked
Initialize_Attributes_Link : Proc_T := Initialize_Attributes'Access;
-- should be called with abortion deferred, but holding no locks
-- should be called with abort deferred, but holding no locks
-------------------------
-- Abort Defer/Undefer --
......@@ -75,36 +75,34 @@ package System.Tasking.Initialization is
-- 2) abort/ATC
-- Abort deferral MAY be nested (Self_ID.Deferral_Level is a count),
-- but to avoid waste and undetected errors, it generally SHOULD NOT
-- be nested. The symptom of over-deferring abort is that an exception
-- may fail to be raised, or an abort may fail to take place.
-- Abort deferral MAY be nested (Self_ID.Deferral_Level is a count), but
-- to avoid waste and undetected errors, it generally SHOULD NOT be
-- nested. The symptom of over-deferring abort is that an exception may
-- fail to be raised, or an abort may fail to take place.
-- Therefore, there are two sets of the inlinable defer/undefer
-- routines, which are the ones to be used inside GNARL.
-- One set allows nesting. The other does not. People who
-- maintain the GNARL should try to avoid using the nested versions,
-- or at least look very critically at the places where they are
-- used.
-- Therefore, there are two sets of the inlinable defer/undefer routines,
-- which are the ones to be used inside GNARL. One set allows nesting. The
-- other does not. People who maintain the GNARL should try to avoid using
-- the nested versions, or at least look very critically at the places
-- where they are used.
-- In general, any GNARL call that is potentially blocking, or
-- whose semantics require that it sometimes raise an exception,
-- or that is required to be an abort completion point, must be
-- made with abort Deferral_Level = 1.
-- In general, any GNARL call that is potentially blocking, or whose
-- semantics require that it sometimes raise an exception, or that is
-- required to be an abort completion point, must be made with abort
-- Deferral_Level = 1.
-- In general, non-blocking GNARL calls, which may be made from inside
-- a protected action, are likely to need to allow nested abort
-- deferral.
-- In general, non-blocking GNARL calls, which may be made from inside a
-- protected action, are likely to need to allow nested abort deferral.
-- With some critical exceptions (which are supposed to be documented),
-- internal calls to the tasking runtime system assume abort is already
-- deferred, and do not modify the deferral level.
-- There is also a set of non-linable defer/undefer routines,
-- for direct call from the compiler. These are not in-lineable
-- because they may need to be called via pointers ("soft links").
-- For the sake of efficiency, the version with Self_ID as parameter
-- should used wherever possible. These are all nestable.
-- There is also a set of non-linable defer/undefer routines, for direct
-- call from the compiler. These are not in-lineable because they may need
-- to be called via pointers ("soft links"). For the sake of efficiency,
-- the version with Self_ID as parameter should used wherever possible.
-- These are all nestable.
-- Non-nestable inline versions
......@@ -128,16 +126,14 @@ package System.Tasking.Initialization is
procedure Defer_Abortion;
procedure Undefer_Abortion;
-- ?????
-- Try to phase out all uses of the above versions.
-- Try to phase out all uses of the above versions ???
procedure Do_Pending_Action (Self_ID : Task_Id);
-- Only call with no locks, and when Self_ID.Pending_Action = True
-- Perform necessary pending actions (e.g. abortion, priority change).
-- This procedure is usually called when needed as a result of
-- calling Undefer_Abort, although in the case of e.g. No_Abort
-- restriction, it can be necessary to force execution of pending
-- actions.
-- Only call with no locks, and when Self_ID.Pending_Action = True Perform
-- necessary pending actions (e.g. abort, priority change). This procedure
-- is usually called when needed as a result of calling Undefer_Abort,
-- although in the case of e.g. No_Abort restriction, it can be necessary
-- to force execution of pending actions.
function Check_Abort_Status return Integer;
-- Returns Boolean'Pos (True) iff abort signal should raise
......@@ -148,9 +144,8 @@ package System.Tasking.Initialization is
--------------------------
procedure Change_Base_Priority (T : Task_Id);
-- Change the base priority of T.
-- Has to be called with the affected task's ATCB write-locked.
-- May temporariliy release the lock.
-- Change the base priority of T. Has to be called with the affected
-- task's ATCB write-locked. May temporariliy release the lock.
procedure Poll_Base_Priority_Change (Self_ID : Task_Id);
-- Has to be called with Self_ID's ATCB write-locked.
......@@ -170,44 +165,41 @@ package System.Tasking.Initialization is
-- within the GNARL.
procedure Final_Task_Unlock (Self_ID : Task_Id);
-- This version is only for use in Terminate_Task, when the task
-- is relinquishing further rights to its own ATCB.
-- There is a very interesting potential race condition there, where
-- the old task may run concurrently with a new task that is allocated
-- the old tasks (now reused) ATCB. The critical thing here is to
-- not make any reference to the ATCB after the lock is released.
-- See also comments on Terminate_Task and Unlock.
-- This version is only for use in Terminate_Task, when the task is
-- relinquishing further rights to its own ATCB. There is a very
-- interesting potential race condition there, where the old task may run
-- concurrently with a new task that is allocated the old tasks (now
-- reused) ATCB. The critical thing here is to not make any reference to
-- the ATCB after the lock is released. See also comments on
-- Terminate_Task and Unlock.
procedure Wakeup_Entry_Caller
(Self_ID : Task_Id;
Entry_Call : Entry_Call_Link;
New_State : Entry_Call_State);
pragma Inline (Wakeup_Entry_Caller);
-- This is called at the end of service of an entry call,
-- to abort the caller if he is in an abortable part, and
-- to wake up the caller if he is on Entry_Caller_Sleep.
-- Call it holding the lock of Entry_Call.Self.
-- This is called at the end of service of an entry call, to abort the
-- caller if he is in an abortable part, and to wake up the caller if he
-- is on Entry_Caller_Sleep. Call it holding the lock of Entry_Call.Self.
--
-- Timed_Call or Simple_Call:
-- The caller is waiting on Entry_Caller_Sleep, in
-- Wait_For_Completion, or Wait_For_Completion_With_Timeout.
-- The caller is waiting on Entry_Caller_Sleep, in Wait_For_Completion,
-- or Wait_For_Completion_With_Timeout.
--
-- Conditional_Call:
-- The caller might be in Wait_For_Completion,
-- waiting for a rendezvous (possibly requeued without abort)
-- to complete.
-- waiting for a rendezvous (possibly requeued without abort) to
-- complete.
--
-- Asynchronous_Call:
-- The caller may be executing in the abortable part o
-- an async. select, or on a time delay,
-- if Entry_Call.State >= Was_Abortable.
-- The caller may be executing in the abortable part an async. select,
-- or on a time delay, if Entry_Call.State >= Was_Abortable.
procedure Locked_Abort_To_Level
(Self_ID : Task_Id;
T : Task_Id;
L : ATC_Level);
pragma Inline (Locked_Abort_To_Level);
-- Abort a task to a specified ATC level.
-- Call this only with T locked.
-- Abort a task to a specified ATC level. Call this only with T locked
end System.Tasking.Initialization;
......@@ -36,24 +36,24 @@ pragma Polling (Off);
-- tasking operations. It causes infinite loops and other problems.
with Ada.Exceptions;
-- used for Raise_Exception
-- Used for Raise_Exception
with System.Tasking.Debug;
-- used for enabling tasking facilities with gdb
-- Used for enabling tasking facilities with gdb
with System.Address_Image;
-- used for the function itself.
-- Used for the function itself
with System.Parameters;
-- used for Size_Type
-- Used for Size_Type
-- Single_Lock
-- Runtime_Traces
with System.Task_Info;
-- used for Task_Info_Type
-- Used for Task_Info_Type
with System.Task_Primitives.Operations;
-- used for Finalize_Lock
-- Used for Finalize_Lock
-- Enter_Task
-- Write_Lock
-- Unlock
......@@ -64,11 +64,11 @@ with System.Task_Primitives.Operations;
-- 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
-- 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
with System.Tasking.Initialization;
-- Used for Remove_From_All_Tasks_List
......@@ -79,7 +79,7 @@ with System.Tasking.Initialization;
-- Initialize_Attributes_Link
pragma Elaborate_All (System.Tasking.Initialization);
-- This insures that tasking is initialized if any tasks are created.
-- This insures that tasking is initialized if any tasks are created
with System.Tasking.Utilities;
-- Used for Make_Passive
......@@ -98,22 +98,22 @@ with System.Finalization_Implementation;
-- Used for System.Finalization_Implementation.Finalize_Global_List
with System.Secondary_Stack;
-- used for SS_Init
-- Used for SS_Init
with System.Storage_Elements;
-- used for Storage_Array
-- Used for Storage_Array
with System.Restrictions;
-- used for Abort_Allowed
-- Used for Abort_Allowed
with System.Standard_Library;
-- used for Exception_Trace
-- Used for Exception_Trace
with System.Traces.Tasking;
-- used for Send_Trace_Info
-- Used for Send_Trace_Info
with Unchecked_Deallocation;
-- To recover from failure of ATCB initialization.
-- To recover from failure of ATCB initialization
package body System.Tasking.Stages is
......@@ -787,11 +787,11 @@ package body System.Tasking.Stages is
Self_ID.Callable := False;
-- Exit level 2 master, for normal tasks in library-level packages.
-- Exit level 2 master, for normal tasks in library-level packages
Complete_Master;
-- Force termination of "independent" library-level server tasks.
-- Force termination of "independent" library-level server tasks
Lock_RTS;
......@@ -977,7 +977,7 @@ package body System.Tasking.Stages is
-- clean ups associated with the exception handler that need to
-- access task specific data.
-- Defer abortion so that this task can't be aborted while exiting
-- Defer abort so that this task can't be aborted while exiting
when Standard'Abort_Signal =>
Initialization.Defer_Abort_Nestable (Self_ID);
......@@ -1209,7 +1209,7 @@ package body System.Tasking.Stages is
-- The activator raises a Tasking_Error if any task it is activating
-- is completed before the activation is done. However, if the reason
-- for the task completion is an abortion, we do not raise an exception.
-- for the task completion is an abort, we do not raise an exception.
-- See RM 9.2(5).
if not Self_ID.Callable and then Self_ID.Pending_ATC_Level /= 0 then
......@@ -1392,7 +1392,7 @@ package body System.Tasking.Stages is
pragma Assert (Self_ID.Common.Wait_Count = 0);
-- Force any remaining dependents to terminate, by aborting them.
-- Force any remaining dependents to terminate by aborting them
if not Single_Lock then
Lock_RTS;
......@@ -1461,8 +1461,8 @@ package body System.Tasking.Stages is
Unlock (Self_ID);
end if;
-- We don't wake up for abortion here. We are already terminating
-- just as fast as we can, so there is no point.
-- We don't wake up for abort here. We are already terminating just as
-- 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,
......@@ -1687,7 +1687,7 @@ package body System.Tasking.Stages is
-- Package elaboration code
begin
-- Establish the Adafinal softlink.
-- Establish the Adafinal softlink
-- This is not done inside the central RTS initialization routine
-- to avoid with-ing this package from System.Tasking.Initialization.
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -121,9 +121,9 @@ package System.Tasking.Stages is
-- activate_tasks (_chain'unchecked_access);
procedure Abort_Tasks (Tasks : Task_List);
-- Compiler interface only. Do not call from within the RTS.
-- Initiate abortion, however, the actual abortion is done by abortee by
-- means of Abort_Handler and Abort_Undefer
-- Compiler interface only. Do not call from within the RTS. Initiate
-- abort, however, the actual abort is done by abortee by means of
-- Abort_Handler and Abort_Undefer
--
-- source code:
-- Abort T1, T2;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -72,9 +72,9 @@ package System.Tasking.Utilities is
-- the environment task (because every independent task depends on it),
-- this counter is protected by the environment task's lock.
------------------------------------
-- Task Abortion related routines --
------------------------------------
---------------------------------
-- Task Abort Related Routines --
---------------------------------
procedure Cancel_Queued_Entry_Calls (T : Task_Id);
-- Cancel any entry calls queued on target task.
......@@ -93,13 +93,13 @@ package System.Tasking.Utilities is
-- (3) always aborts whole task
procedure Abort_Tasks (Tasks : Task_List);
-- Abort_Tasks is called to initiate abortion, however, the actual
-- abortion is done by abortee by means of Abort_Handler
-- Abort_Tasks is called to initiate abort, however, the actual
-- aborti is done by aborted task by means of Abort_Handler
procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean);
-- Update counts to indicate current task is either terminated
-- or accepting on a terminate alternative.
-- Call holding no locks except Global_Task_Lock when calling from
-- Terminate_Task, and RTS_Lock when Single_Lock is True.
-- Update counts to indicate current task is either terminated or
-- accepting on a terminate alternative. Call holding no locks except
-- Global_Task_Lock when calling from Terminate_Task, and RTS_Lock when
-- Single_Lock is True.
end System.Tasking.Utilities;
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Ada Core Technologies --
-- Copyright (C) 1995-2005, Ada Core Technologies --
-- --
-- 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,13 +32,13 @@
-- --
------------------------------------------------------------------------------
-- This package provides support for the body of Ada.Task_Attributes.
-- This package provides support for the body of Ada.Task_Attributes
with Ada.Finalization;
-- used for Limited_Controlled
-- Used for Limited_Controlled
with System.Storage_Elements;
-- used for Integer_Address
-- Used for Integer_Address
package System.Tasking.Task_Attributes is
......@@ -52,8 +52,8 @@ package System.Tasking.Task_Attributes is
function To_Access_Node is new Unchecked_Conversion
(Access_Address, Access_Node);
-- Used to fetch pointer to indirect attribute list. Declaration is
-- in spec to avoid any problems with aliasing assumptions.
-- Used to fetch pointer to indirect attribute list. Declaration is in
-- spec to avoid any problems with aliasing assumptions.
type Dummy_Wrapper;
type Access_Dummy_Wrapper is access all Dummy_Wrapper;
......@@ -67,7 +67,7 @@ package System.Tasking.Task_Attributes is
-- of type Wrapper, no Dummy_Wrapper objects are ever created.
type Deallocator is access procedure (P : in out Access_Node);
-- Called to deallocate an Wrapper. P is a pointer to a Node within.
-- Called to deallocate an Wrapper. P is a pointer to a Node within
type Instance;
......@@ -78,11 +78,11 @@ package System.Tasking.Task_Attributes is
Initial_Value : aliased System.Storage_Elements.Integer_Address;
Index : Direct_Index;
-- The index of the TCB location used by this instantiation,
-- if it is stored in the TCB, otherwise zero.
-- The index of the TCB location used by this instantiation, if it is
-- stored in the TCB, otherwise zero.
Next : Access_Instance;
-- Next instance in All_Attributes list.
-- Next instance in All_Attributes list
end record;
procedure Finalize (X : in out Instance);
......@@ -93,12 +93,11 @@ package System.Tasking.Task_Attributes is
Next : Access_Node;
end record;
-- The following type is a stand-in for the actual
-- wrapper type, which is different for each instantiation
-- of Ada.Task_Attributes.
-- The following type is a stand-in for the actual wrapper type, which is
-- different for each instantiation of Ada.Task_Attributes.
type Dummy_Wrapper is record
Noed : aliased Node;
Dummy_Node : aliased Node;
Value : aliased Attribute;
-- The generic formal type, may be controlled
......@@ -110,23 +109,23 @@ package System.Tasking.Task_Attributes is
-- Ensure that the designated object is always strictly enough aligned.
In_Use : Direct_Index_Vector := 0;
-- is True for direct indices that are already used.
-- Set True for direct indices that are already used (True??? type???)
All_Attributes : Access_Instance;
-- A linked list of all indirectly access attributes,
-- which includes all those that require finalization.
-- A linked list of all indirectly access attributes, which includes all
-- those that require finalization.
procedure Initialize_Attributes (T : Task_Id);
-- Initialize all attributes created via Ada.Task_Attributes for T.
-- This must be called by the creator of the task, inside Create_Task,
-- via soft-link Initialize_Attributes_Link. On entry, abortion must
-- be deferred and the caller must hold no locks
-- Initialize all attributes created via Ada.Task_Attributes for T. This
-- must be called by the creator of the task, inside Create_Task, via
-- soft-link Initialize_Attributes_Link. On entry, abort must be deferred
-- and the caller must hold no locks
procedure Finalize_Attributes (T : Task_Id);
-- Finalize all attributes created via Ada.Task_Attributes for T.
-- This is to be called by the task after it is marked as terminated
-- (and before it actually dies), inside Vulnerable_Free_Task, via the
-- soft-link Finalize_Attributes_Link. On entry, abortion must be deferred
-- soft-link Finalize_Attributes_Link. On entry, abort must be deferred
-- and T.L must be write-locked.
end System.Tasking.Task_Attributes;
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -31,39 +31,40 @@
-- --
------------------------------------------------------------------------------
-- This package contains all the simple primitives related to
-- Protected_Objects with entries (i.e init, lock, unlock).
-- This package contains all the 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.
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Note: the compiler generates direct calls to this interface, via Rtsfind
with Ada.Exceptions;
-- used for Exception_Occurrence_Access
-- Used for Exception_Occurrence_Access
-- Raise_Exception
with System.Task_Primitives.Operations;
-- used for Initialize_Lock
-- Used for Initialize_Lock
-- Write_Lock
-- Unlock
-- Get_Priority
-- Wakeup
with System.Tasking.Initialization;
-- used for Defer_Abort,
-- 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
-- This insures that tasking is initialized if any protected objects are
-- created.
with System.Parameters;
-- used for Single_Lock
-- Used for Single_Lock
package body System.Tasking.Protected_Objects.Entries is
......@@ -103,8 +104,9 @@ package body System.Tasking.Protected_Objects.Entries is
end if;
if Ceiling_Violation then
-- Dip our own priority down to ceiling of lock.
-- See similar code in Tasking.Entry_Calls.Lock_Server.
-- Dip our own priority down to ceiling of lock. See similar code in
-- Tasking.Entry_Calls.Lock_Server.
STPO.Write_Lock (Self_ID);
Old_Base_Priority := Self_ID.Common.Base_Priority;
......@@ -130,7 +132,7 @@ package body System.Tasking.Protected_Objects.Entries is
Object.Pending_Action := True;
end if;
-- Send program_error to all tasks still queued on this object.
-- Send program_error to all tasks still queued on this object
for E in Object.Entry_Queues'Range loop
Entry_Call := Object.Entry_Queues (E).Head;
......@@ -229,10 +231,10 @@ package body System.Tasking.Protected_Objects.Entries is
(Program_Error'Identity, "Protected Object is finalized");
end if;
-- If pragma Detect_Blocking is active then Program_Error must
-- be raised if this potentially blocking operation is called from
-- a protected action, and the protected object nesting level
-- must be increased.
-- If pragma Detect_Blocking is active then Program_Error must be
-- raised if this potentially blocking operation is called from a
-- protected action, and the protected object nesting level must be
-- increased.
if Detect_Blocking then
declare
......@@ -242,8 +244,8 @@ package body System.Tasking.Protected_Objects.Entries is
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
else
-- We are entering in a protected action, so that we
-- increase the protected object nesting level.
-- We are entering in a protected action, so that we increase
-- the protected object nesting level.
Self_Id.Common.Protected_Action_Nesting :=
Self_Id.Common.Protected_Action_Nesting + 1;
......@@ -251,15 +253,15 @@ package body System.Tasking.Protected_Objects.Entries is
end;
end if;
-- The lock is made without defering abortion.
-- The lock is made without defering abort
-- Therefore the abortion has to be deferred before calling this
-- routine. This means that the compiler has to generate a Defer_Abort
-- call before the call to Lock.
-- Therefore the abort has to be deferred before calling this routine.
-- This means that the compiler has to generate a Defer_Abort call
-- before the call to Lock.
-- The caller is responsible for undeferring abortion, and compiler
-- The caller is responsible for undeferring abort, and compiler
-- generated calls must be protected with cleanup handlers to ensure
-- that abortion is undeferred in all cases.
-- that abort is undeferred in all cases.
pragma Assert (STPO.Self.Deferral_Level > 0);
Write_Lock (Object.L'Access, Ceiling_Violation);
......@@ -302,8 +304,8 @@ package body System.Tasking.Protected_Objects.Entries is
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
else
-- We are entering in a protected action, so that we
-- increase the protected object nesting level.
-- We are entering in a protected action, so that we increase
-- the protected object nesting level.
Self_Id.Common.Protected_Action_Nesting :=
Self_Id.Common.Protected_Action_Nesting + 1;
......
......@@ -2,12 +2,11 @@
-- --
-- GNU ADA 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-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -32,19 +31,20 @@
-- --
------------------------------------------------------------------------------
-- This package contains all the extended primitives related to
-- Protected_Objects with entries.
-- This package contains all the 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
-- objects with entries in System.Tasking.Protected_Objects.Entries.
-- The split between Entries and Operations is needed to break circular
-- objects with entries in System.Tasking.Protected_Objects.Entries. The
-- split between Entries and Operations is needed to break circular
-- dependencies inside the run time.
-- Note: the compiler generates direct calls to this interface, via Rtsfind.
-- Any changes to this interface may require corresponding compiler changes.
with Ada.Exceptions;
-- used for Exception_Id
-- Used for Exception_Id
with System.Tasking.Protected_Objects.Entries;
......@@ -108,7 +108,7 @@ package System.Tasking.Protected_Objects.Operations is
-- barriers, so this routine keeps checking barriers until all of
-- them are closed.
--
-- This must be called with abortion deferred and with the corresponding
-- This must be called with abort deferred and with the corresponding
-- object locked.
--
-- If Unlock_Object is set True, then Object is unlocked on return,
......@@ -173,7 +173,7 @@ package System.Tasking.Protected_Objects.Operations is
(Object : Entries.Protection_Entries'Class;
E : Protected_Entry_Index)
return Natural;
-- Return the number of entry calls to E on Object.
-- Return the number of entry calls to E on Object
function Protected_Entry_Caller
(Object : Entries.Protection_Entries'Class) return Task_Id;
......@@ -181,7 +181,7 @@ package System.Tasking.Protected_Objects.Operations is
-- being handled. This will only work if called from within an entry
-- body, as required by the LRM (C.7.1(14)).
-- For internal use only:
-- For internal use only
procedure PO_Do_Or_Queue
(Self_ID : Task_Id;
......@@ -189,7 +189,7 @@ package System.Tasking.Protected_Objects.Operations is
Entry_Call : Entry_Call_Link;
With_Abort : Boolean);
-- This procedure either executes or queues an entry call, depending
-- on the status of the corresponding barrier. It assumes that abortion
-- on the status of the corresponding barrier. It assumes that abort
-- is deferred and that the specified object is locked.
private
......@@ -201,10 +201,9 @@ private
pragma Volatile (Communication_Block);
-- ?????
-- The Communication_Block seems to be a relic.
-- At the moment, the compiler seems to be generating
-- unnecessary conditional code based on this block.
-- See the code generated for async. select with task entry
-- The Communication_Block seems to be a relic. At the moment, the
-- compiler seems to be generating unnecessary conditional code based on
-- this block. See the code generated for async. select with task entry
-- call for another way of solving this.
end System.Tasking.Protected_Objects.Operations;
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -72,16 +72,16 @@ package Tbuild is
function Make_DT_Component
(Loc : Source_Ptr;
Typ : Entity_Id;
I : Positive) return Node_Id;
-- Gives a reference to the Ith component of the Dispatch Table of
N : Positive) return Node_Id;
-- Gives a reference to the Nth component of the Dispatch Table of
-- a given Tagged Type.
--
-- I = 1 --> Inheritance_Depth
-- I = 2 --> Tags (array of ancestors)
-- I = 3, 4 --> predefined primitive
-- N = 1 --> Inheritance_Depth
-- N = 2 --> Tags (array of ancestors)
-- N = 3, 4 --> predefined primitive
-- function _Size (X : Typ) return Long_Long_Integer;
-- function _Equality (X : Typ; Y : Typ'Class) return Boolean;
-- I >= 5 --> User-Defined Primitive Operations
-- N >= 5 --> User-Defined Primitive Operations
function Make_DT_Access
(Loc : Source_Ptr; Rec : Node_Id; Typ : Entity_Id) return Node_Id;
......
......@@ -679,7 +679,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
|| (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== ARRAY_TYPE))
&& (0 == (best_type
== find_common_type (right_type,
= find_common_type (right_type,
TREE_TYPE (TREE_OPERAND
(right_operand, 0))))
|| right_type != best_type))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment