OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-07-16  Bob Duff  <duff@adacore.com>

	* gnat_ugn.texi: Document need for project file
	for --incremental switch for gnat2xml.

2014-07-16  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Fix example of non-packable components in packed
	records section.

2014-07-16  Robert Dewar  <dewar@adacore.com>

	* s-tpoben.adb, s-tasren.adb, s-interr.adb, s-interr-hwint.adb,
	s-shasto.adb, s-interr-vms.adb, s-interr-sigaction.adb: Avoid use of
	upper case in exception messages.

From-SVN: r212650
This commit is contained in:
Arnaud Charlet 2014-07-16 16:19:43 +02:00
parent ea70f3d0c1
commit 350f5d3bc4
10 changed files with 305 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2014-07-16 Bob Duff <duff@adacore.com>
* gnat_ugn.texi: Document need for project file
for --incremental switch for gnat2xml.
2014-07-16 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Fix example of non-packable components in packed
records section.
2014-07-16 Robert Dewar <dewar@adacore.com>
* s-tpoben.adb, s-tasren.adb, s-interr.adb, s-interr-hwint.adb,
s-shasto.adb, s-interr-vms.adb, s-interr-sigaction.adb: Avoid use of
upper case in exception messages.
2014-07-16 Robert Dewar <dewar@adacore.com>
* snames.ads-tmpl, sem_attr.adb, exp_attr.adb: Same_Storage attribute

11
gcc/ada/gnat_rm.texi
View File

@ -15464,7 +15464,8 @@ taken by components. We distinguish between @emph{packable} components and
Components of the following types are considered packable:
@itemize @bullet
@item
All primitive types are packable.
Components of a primitive type are packable unless they are aliased
or of an atomic type.
@item
Small packed arrays, whose size does not exceed 64 bits, and where the
@ -15491,10 +15492,12 @@ For example, consider the record
type Rb2 is array (1 .. 65) of Boolean;
pragma Pack (rb2);
type AF is new Float with Atomic;
type x2 is record
l1 : Boolean;
l2 : Duration;
l3 : Float;
l3 : AF;
l4 : Boolean;
l5 : Rb1;
l6 : Rb2;
@ -15522,8 +15525,8 @@ Studying this example, we see that the packable fields @code{l1}
and @code{l2} are
of length equal to their sizes, and placed at specific bit boundaries (and
not byte boundaries) to
eliminate padding. But @code{l3} is of a non-packable float type, so
it is on the next appropriate alignment boundary.
eliminate padding. But @code{l3} is of a non-packable float type (because
it is aliased), so it is on the next appropriate alignment boundary.
The next two fields are fully packable, so @code{l4} and @code{l5} are
minimally packed with no gaps. However, type @code{Rb2} is a packed

3
gcc/ada/gnat_ugn.texi
View File

@ -15145,7 +15145,8 @@ Options:
--incremental -- incremental processing on a per-file basis. Source files are
only processed if they have been modified, or if files they depend
on have been modified. This is similar to the way gnatmake/gprbuild
only compiles files that need to be recompiled.
only compiles files that need to be recompiled. You need to use a project
file for this to work.
--output-dir=@var{dir} -- generate one .xml file for each Ada source file, in
directory @file{dir}. (Default is to generate the XML to standard

192
gcc/ada/s-interr-hwint.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -54,14 +54,14 @@
-- 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
-- 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 reasonably generic version of this package, supporting vectored
-- hardware interrupts using non-RTOS specific adapter routines which
-- should easily implemented on any RTOS capable of supporting GNAT.
-- hardware interrupts using non-RTOS specific adapter routines which should
-- easily implemented on any RTOS capable of supporting GNAT.
with Ada.Unchecked_Conversion;
with Ada.Task_Identification;
@ -92,8 +92,8 @@ package body System.Interrupts is
-- Local Tasks --
-----------------
-- WARNING: System.Tasking.Stages performs calls to this task with
-- low-level constructs. Do not change this spec without synchronizing it.
-- WARNING: System.Tasking.Stages performs calls to this task with low-
-- level constructs. Do not change this spec without synchronizing it.
task Interrupt_Manager is
entry Detach_Interrupt_Entries (T : Task_Id);
@ -148,8 +148,8 @@ package body System.Interrupts is
(others => (null, Static => False));
pragma Volatile_Components (User_Handler);
-- Holds the protected procedure handler (if any) and its Static
-- information for each interrupt or signal. A handler is static
-- iff it is specified through the pragma Attach_Handler.
-- information for each interrupt or signal. A handler is static iff it
-- is specified through the pragma Attach_Handler.
User_Entry : array (Interrupt_ID) of Entry_Assoc :=
(others => (T => Null_Task, E => Null_Task_Entry));
@ -181,8 +181,8 @@ package body System.Interrupts is
Semaphore_ID_Map : array
(Interrupt_ID range 0 .. System.OS_Interface.Max_HW_Interrupt)
of Binary_Semaphore_Id := (others => 0);
-- Array of binary semaphores associated with vectored interrupts
-- Note that the last bound should be Max_HW_Interrupt, but this will raise
-- Array of binary semaphores associated with vectored interrupts. Note
-- that the last bound should be Max_HW_Interrupt, but this will raise
-- Storage_Error if Num_HW_Interrupts is null, so use an extra 4 bytes
-- instead.
@ -190,9 +190,9 @@ package body System.Interrupts is
-- Variable for allocating an Interrupt_Server_Task
Handler_Installed : array (HW_Interrupt) of Boolean := (others => False);
-- True if Notify_Interrupt was connected to the interrupt. Handlers
-- can be connected but disconnection is not possible on VxWorks.
-- Therefore we ensure Notify_Installed is connected at most once.
-- True if Notify_Interrupt was connected to the interrupt. Handlers can
-- be connected but disconnection is not possible on VxWorks. Therefore
-- we ensure Notify_Installed is connected at most once.
-----------------------
-- Local Subprograms --
@ -230,12 +230,12 @@ package body System.Interrupts is
--------------------
-- Calling this procedure with New_Handler = null and Static = True
-- means we want to detach the current handler regardless of the
-- previous handler's binding status (i.e. do not care if it is a
-- dynamic or static handler).
-- means we want to detach the current handler regardless of the previous
-- handler's binding status (i.e. do not care if it is a dynamic or static
-- handler).
-- This option is needed so that during the finalization of a PO, we
-- can detach handlers attached through pragma Attach_Handler.
-- This option is needed so that during the finalization of a PO, we can
-- detach handlers attached through pragma Attach_Handler.
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
@ -260,8 +260,7 @@ package body System.Interrupts is
Int_Ref : System.Address)
is
Interrupt : constant Interrupt_ID :=
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
begin
Check_Reserved_Interrupt (Interrupt);
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
@ -284,7 +283,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
else
return;
end if;
@ -300,9 +299,9 @@ package body System.Interrupts is
begin
Check_Reserved_Interrupt (Interrupt);
-- ??? Since Parameterless_Handler is not Atomic, the
-- current implementation is wrong. We need a new service in
-- Interrupt_Manager to ensure atomicity.
-- ??? Since Parameterless_Handler is not Atomic, the current
-- implementation is wrong. We need a new service in Interrupt_Manager
-- to ensure atomicity.
return User_Handler (Interrupt).H;
end Current_Handler;
@ -320,7 +319,8 @@ package body System.Interrupts is
procedure Detach_Handler
(Interrupt : Interrupt_ID;
Static : Boolean := False) is
Static : Boolean := False)
is
begin
Check_Reserved_Interrupt (Interrupt);
Interrupt_Manager.Detach_Handler (Interrupt, Static);
@ -340,12 +340,12 @@ package body System.Interrupts is
----------------------
-- Calling this procedure with New_Handler = null and Static = True
-- means we want to detach the current handler regardless of the
-- previous handler's binding status (i.e. do not care if it is a
-- dynamic or static handler).
-- means we want to detach the current handler regardless of the previous
-- handler's binding status (i.e. we do not care if it is a dynamic or
-- static handler).
-- This option is needed so that during the finalization of a PO, we
-- can detach handlers attached through pragma Attach_Handler.
-- This option is needed so that during the finalization of a PO, we can
-- detach handlers attached through pragma Attach_Handler.
procedure Exchange_Handler
(Old_Handler : out Parameterless_Handler;
@ -394,7 +394,6 @@ package body System.Interrupts is
procedure Finalize_Interrupt_Servers is
HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
begin
if HW_Interrupts then
for Int in HW_Interrupt loop
@ -405,8 +404,8 @@ package body System.Interrupts is
then
Interrupt_Manager.Attach_Handler
(New_Handler => null,
Interrupt => Interrupt_ID (Int),
Static => True,
Interrupt => Interrupt_ID (Int),
Static => True,
Restoration => True);
end if;
end loop;
@ -579,7 +578,6 @@ package body System.Interrupts is
Fat := To_Fat_Ptr (Handler);
Ptr := Registered_Handler_Head;
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
@ -605,31 +603,28 @@ package body System.Interrupts is
-- Notify_Interrupt --
----------------------
-- Umbrella handler for vectored hardware interrupts (as opposed to
-- signals and exceptions). As opposed to the signal implementation,
-- this handler is installed in the vector table when the first Ada
-- handler is attached to the interrupt. However because VxWorks don't
-- support disconnecting handlers, this subprogram always test whether
-- or not an Ada handler is effectively attached.
-- Umbrella handler for vectored hardware interrupts (as opposed to signals
-- and exceptions). As opposed to the signal implementation, this handler
-- is installed in the vector table when the first Ada handler is attached
-- to the interrupt. However because VxWorks don't support disconnecting
-- handlers, this subprogram always test whether or not an Ada handler is
-- effectively attached.
-- Otherwise, the handler that existed prior to program startup is
-- in the vector table. This ensures that handlers installed by
-- the BSP are active unless explicitly replaced in the program text.
-- Otherwise, the handler that existed prior to program startup is in the
-- vector table. This ensures that handlers installed by the BSP are active
-- unless explicitly replaced in the program text.
-- Each Interrupt_Server_Task has an associated binary semaphore
-- on which it pends once it's been started. This routine determines
-- The appropriate semaphore and issues a semGive call, waking
-- the server task. When a handler is unbound,
-- System.Interrupts.Unbind_Handler issues a Binary_Semaphore_Flush,
-- and the server task deletes its semaphore and terminates.
-- Each Interrupt_Server_Task has an associated binary semaphore on which
-- it pends once it's been started. This routine determines The appropriate
-- semaphore and issues a semGive call, waking the server task. When
-- a handler is unbound, System.Interrupts.Unbind_Handler issues a
-- Binary_Semaphore_Flush, and the server task deletes its semaphore
-- and terminates.
procedure Notify_Interrupt (Param : System.Address) is
Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);
Status : int;
Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);
Status : int;
begin
if Id /= 0 then
Status := Binary_Semaphore_Release (Id);
@ -645,7 +640,7 @@ package body System.Interrupts is
begin
Check_Reserved_Interrupt (Interrupt);
return Storage_Elements.To_Address
(Storage_Elements.Integer_Address (Interrupt));
(Storage_Elements.Integer_Address (Interrupt));
end Reference;
--------------------------------
@ -656,15 +651,15 @@ package body System.Interrupts is
New_Node_Ptr : R_Link;
begin
-- This routine registers a handler as usable for dynamic
-- interrupt handler association. Routines attaching and detaching
-- handlers dynamically should determine whether the handler is
-- registered. Program_Error should be raised if it is not registered.
-- This routine registers a handler as usable for dynamic interrupt
-- handler association. Routines attaching and detaching handlers
-- dynamically should determine whether the handler is registered.
-- Program_Error should be raised if it is not registered.
-- Pragma Interrupt_Handler can only appear in a library
-- level PO definition and instantiation. Therefore, we do not need
-- to implement an unregister operation. Nor do we need to
-- protect the queue structure with a lock.
-- Pragma Interrupt_Handler can only appear in a library level PO
-- definition and instantiation. Therefore, we do not need to implement
-- an unregister operation. Nor do we need to protect the queue
-- structure with a lock.
pragma Assert (Handler_Addr /= System.Null_Address);
@ -674,7 +669,6 @@ package body System.Interrupts is
if Registered_Handler_Head = null then
Registered_Handler_Head := New_Node_Ptr;
Registered_Handler_Tail := New_Node_Ptr;
else
Registered_Handler_Tail.Next := New_Node_Ptr;
Registered_Handler_Tail := New_Node_Ptr;
@ -717,7 +711,7 @@ package body System.Interrupts is
procedure Unimplemented (Feature : String) is
begin
raise Program_Error with Feature & " not implemented on VxWorks";
raise Program_Error with feature & " not implemented on VxWorks";
end Unimplemented;
-----------------------
@ -732,8 +726,8 @@ package body System.Interrupts is
procedure Bind_Handler (Interrupt : Interrupt_ID);
-- This procedure does not do anything if a signal is blocked.
-- Otherwise, we have to interrupt Server_Task for status change through
-- a wakeup signal.
-- Otherwise, we have to interrupt Server_Task for status change
-- through a wakeup signal.
procedure Unbind_Handler (Interrupt : Interrupt_ID);
-- This procedure does not do anything if a signal is blocked.
@ -767,8 +761,8 @@ package body System.Interrupts is
procedure Unbind_Handler (Interrupt : Interrupt_ID) is
Status : int;
begin
begin
-- Flush server task off semaphore, allowing it to terminate
Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
@ -786,11 +780,12 @@ package body System.Interrupts is
Old_Handler : Parameterless_Handler;
begin
if User_Entry (Interrupt).T /= Null_Task then
-- If an interrupt entry is installed raise
-- Program_Error. (propagate it to the caller).
-- If an interrupt entry is installed raise Program_Error
-- (propagate it to the caller).
raise Program_Error with
"An interrupt entry is already installed";
"an interrupt entry is already installed";
end if;
-- Note : Static = True will pass the following check. This is the
@ -799,11 +794,11 @@ package body System.Interrupts is
if not Static and then User_Handler (Interrupt).Static then
-- Trying to detach a static Interrupt Handler. raise
-- Trying to detach a static Interrupt Handler, raise
-- Program_Error.
raise Program_Error with
"Trying to detach a static Interrupt Handler";
"trying to detach a static Interrupt Handler";
end if;
Old_Handler := User_Handler (Interrupt).H;
@ -833,32 +828,32 @@ package body System.Interrupts is
if User_Entry (Interrupt).T /= Null_Task then
-- If an interrupt entry is already installed, raise
-- Program_Error. (propagate it to the caller).
-- Program_Error (propagate it to the caller).
raise Program_Error with "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. This is the case when we want to
-- detach a handler regardless of the Static status
-- of 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. This is the case when we want to detach a handler
-- regardless of the Static status of 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
and then (User_Handler (Interrupt).Static
-- Trying to overwrite a static Interrupt Handler with a
-- dynamic Handler
-- Trying to overwrite a static Interrupt Handler with a dynamic
-- Handler
-- The new handler is not specified as an
-- Interrupt Handler by a pragma.
-- The new handler is not specified as an Interrupt Handler by a
-- pragma.
or else not Is_Registered (New_Handler))
then
raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
"dynamic Handler";
"trying to overwrite a static interrupt handler with a "
& "dynamic handler";
end if;
-- Save the old handler
@ -879,8 +874,8 @@ package body System.Interrupts is
User_Handler (Interrupt).Static := Static;
end if;
-- Invoke a corresponding Server_Task if not yet created.
-- Place Task_Id info in Server_ID array.
-- Invoke a corresponding Server_Task if not yet created. Place
-- Task_Id info in Server_ID array.
if New_Handler /= null
and then
@ -909,11 +904,11 @@ package body System.Interrupts is
end if;
end Unprotected_Exchange_Handler;
-- Start of processing for Interrupt_Manager
-- Start of processing for Interrupt_Manager
begin
-- By making this task independent of any master, when the process
-- goes away, the Interrupt_Manager will terminate gracefully.
-- By making this task independent of any master, when the process goes
-- away, the Interrupt_Manager will terminate gracefully.
System.Tasking.Utilities.Make_Independent;
@ -948,15 +943,16 @@ package body System.Interrupts is
or
accept Detach_Handler
(Interrupt : Interrupt_ID;
Static : Boolean)
(Interrupt : Interrupt_ID;
Static : Boolean)
do
Unprotected_Detach_Handler (Interrupt, Static);
end Detach_Handler;
or
accept Bind_Interrupt_To_Entry
(T : Task_Id;
E : Task_Entry_Index;
(T : Task_Id;
E : Task_Entry_Index;
Interrupt : Interrupt_ID)
do
-- If there is a binding already (either a procedure or an
@ -966,7 +962,7 @@ package body System.Interrupts is
or else User_Entry (Interrupt).T /= Null_Task
then
raise Program_Error with
"A binding for this interrupt is already present";
"a binding for this interrupt is already present";
end if;
User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);

30
gcc/ada/s-interr-sigaction.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2014, 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- --
@ -86,8 +86,8 @@ package body System.Interrupts is
Interrupt : Interrupt_ID;
Static : Boolean;
Restoration : Boolean);
-- This internal procedure is needed to finalize protected objects
-- that contain interrupt handlers.
-- This internal procedure is needed to finalize protected objects that
-- contain interrupt handlers.
procedure Signal_Handler (Sig : Interrupt_ID);
pragma Convention (C, Signal_Handler);
@ -157,7 +157,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Descriptors (Interrupt).T /= Null_Task;
@ -171,7 +171,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
else
return Descriptors (Interrupt).Kind /= Unknown;
end if;
@ -329,7 +329,8 @@ package body System.Interrupts is
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID;
Static : Boolean := False) is
Static : Boolean := False)
is
begin
Attach_Handler (New_Handler, Interrupt, Static, False);
end Attach_Handler;
@ -359,8 +360,8 @@ package body System.Interrupts is
or else not Is_Registered (New_Handler))
then
raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
"dynamic Handler";
"trying to overwrite a static interrupt handler with a " &
"dynamic handler";
end if;
if Handlers (Interrupt) = null then
@ -405,10 +406,10 @@ package body System.Interrupts is
if Descriptors (Interrupt).Kind = Task_Entry then
-- In case we have an Interrupt Entry already installed.
-- raise a program error. (propagate it to the caller).
-- In case we have an Interrupt Entry already installed, raise a
-- program error (propagate it to the caller).
raise Program_Error with "An interrupt is already installed";
raise Program_Error with "an interrupt is already installed";
else
Old_Handler := Current_Handler (Interrupt);
@ -430,12 +431,12 @@ package body System.Interrupts is
end if;
if Descriptors (Interrupt).Kind = Task_Entry then
raise Program_Error with "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 Program_Error with
"Trying to detach a static Interrupt Handler";
"trying to detach a static interrupt handler";
end if;
Descriptors (Interrupt) :=
@ -504,7 +505,6 @@ package body System.Interrupts is
Fat := To_Fat_Ptr (Handler);
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
end if;
@ -536,7 +536,7 @@ package body System.Interrupts is
if Descriptors (Interrupt).Kind /= Unknown then
raise Program_Error with
"A binding for this interrupt is already present";
"a binding for this interrupt is already present";
end if;
if Handlers (Interrupt) = null then

145
gcc/ada/s-interr-vms.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -104,8 +104,8 @@ package body System.Interrupts is
Static : Boolean);
entry Detach_Handler
(Interrupt : Interrupt_ID;
Static : Boolean);
(Interrupt : Interrupt_ID;
Static : Boolean);
entry Bind_Interrupt_To_Entry
(T : Task_Id;
@ -172,10 +172,10 @@ package body System.Interrupts is
Last_Unblocker : constant array (Interrupt_ID'Range) of Task_Id :=
(others => Null_Task);
-- ??? pragma Volatile_Components (Last_Unblocker);
-- Holds the ID of the last Task which Unblocked this Interrupt.
-- It contains Null_Task if no tasks have ever requested the
-- Unblocking operation or the Interrupt is currently Blocked.
-- ??? pragma Volatile_Components (Last_Unblocker);
-- Holds the ID of the last Task which Unblocked this Interrupt. It
-- contains Null_Task if no tasks have ever requested the Unblocking
-- operation or the Interrupt is currently Blocked.
Server_ID : array (Interrupt_ID'Range) of Task_Id :=
(others => Null_Task);
@ -185,8 +185,8 @@ package body System.Interrupts is
-- decide whether to create a new Server_Task.
-- Type and Head, Tail of the list containing Registered Interrupt
-- Handlers. These definitions are used to register the handlers specified
-- by the pragma Interrupt_Handler.
-- Handlers. These definitions are used to register the handlers
-- specified by the pragma Interrupt_Handler.
type Registered_Handler;
type R_Link is access all Registered_Handler;
@ -218,15 +218,15 @@ package body System.Interrupts is
New_Node_Ptr : R_Link;
begin
-- This routine registers the Handler as usable for Dynamic
-- Interrupt Handler. Routines attaching and detaching Handler
-- dynamically should first consult if the Handler is registered.
-- A Program Error should be raised if it is not registered.
-- This routine registers the Handler as usable for Dynamic Interrupt
-- Handler. Routines attaching and detaching Handler dynamically should
-- first consult if the Handler is registered. A Program Error should be
-- raised if it is not registered.
-- The pragma Interrupt_Handler can only appear in the library
-- level PO definition and instantiation. Therefore, we do not need
-- to implement Unregistering operation. Neither we need to
-- protect the queue structure using a Lock.
-- The pragma Interrupt_Handler can only appear in the library level PO
-- definition and instantiation. Therefore, we do not need to implement
-- Unregistering operation. Neither we need to protect the queue
-- structure using a Lock.
pragma Assert (Handler_Addr /= System.Null_Address);
@ -267,7 +267,6 @@ package body System.Interrupts is
Fat := To_Fat_Ptr (Handler);
Ptr := Registered_Handler_Head;
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
@ -296,7 +295,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return User_Entry (Interrupt).T /= Null_Task;
@ -310,7 +309,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return User_Handler (Interrupt).H /= null;
@ -324,7 +323,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Blocked (Interrupt);
@ -338,7 +337,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Ignored (Interrupt);
@ -354,7 +353,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
-- ??? Since Parameterless_Handler is not Atomic, the current
@ -369,9 +368,9 @@ package body System.Interrupts is
--------------------
-- Calling this procedure with New_Handler = null and Static = True
-- means we want to detach the current handler regardless of the
-- previous handler's binding status (i.e. do not care if it is a
-- dynamic or static handler).
-- means we want to detach the current handler regardless of the previous
-- handler's binding status (i.e. we do not care if it is a dynamic or
-- static handler).
-- This option is needed so that during the finalization of a PO, we
-- can detach handlers attached through pragma Attach_Handler.
@ -379,15 +378,15 @@ package body System.Interrupts is
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID;
Static : Boolean := False) is
Static : Boolean := False)
is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
end Attach_Handler;
----------------------
@ -411,12 +410,11 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Exchange_Handler
(Old_Handler, New_Handler, Interrupt, Static);
end Exchange_Handler;
--------------------
@ -437,7 +435,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Detach_Handler (Interrupt, Static);
@ -451,11 +449,11 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Storage_Elements.To_Address
(Storage_Elements.Integer_Address (Interrupt));
(Storage_Elements.Integer_Address (Interrupt));
end Reference;
-----------------------------
@ -472,16 +470,15 @@ package body System.Interrupts is
Int_Ref : System.Address)
is
Interrupt : constant Interrupt_ID :=
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
end Bind_Interrupt_To_Entry;
------------------------------
@ -501,7 +498,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Block_Interrupt (Interrupt);
@ -515,7 +512,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Unblock_Interrupt (Interrupt);
@ -530,7 +527,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Last_Unblocker (Interrupt);
@ -544,7 +541,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Ignore_Interrupt (Interrupt);
@ -602,7 +599,7 @@ package body System.Interrupts is
-- In case we have an Interrupt Entry already installed.
-- raise a program error. (propagate it to the caller).
raise Program_Error with "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
@ -618,14 +615,14 @@ package body System.Interrupts is
and then (User_Handler (Interrupt).Static
-- The new handler is not specified as an
-- Interrupt Handler by a pragma.
-- The new handler is not specified as an
-- Interrupt Handler by a pragma.
or else not Is_Registered (New_Handler))
or else not Is_Registered (New_Handler))
then
raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
"dynamic Handler";
"trying to overwrite a static interrupt handler with a " &
"dynamic handler";
end if;
-- The interrupt should no longer be ignored if it was ever ignored
@ -673,11 +670,11 @@ package body System.Interrupts 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).
-- In case we have an Interrupt Entry installed, raise a program
-- error, (propagate it to the caller).
raise Program_Error with
"An interrupt entry is already installed";
"an interrupt entry is already installed";
end if;
-- Note : Static = True will pass the following check. That is the
@ -685,11 +682,11 @@ package body System.Interrupts is
-- status of the current_Handler.
if not Static and then User_Handler (Interrupt).Static then
-- Tries to detach a static Interrupt Handler.
-- raise a program error.
-- Tries to detach a static Interrupt Handler, raise program error
raise Program_Error with
"Trying to detach a static Interrupt Handler";
"trying to detach a static interrupt handler";
end if;
-- The interrupt should no longer be ignored if
@ -708,17 +705,17 @@ package body System.Interrupts is
-- Start of processing for Interrupt_Manager
begin
-- By making this task independent of master, when the process
-- goes away, the Interrupt_Manager will terminate gracefully.
-- By making this task independent of master, when the process goes
-- away, the Interrupt_Manager will terminate gracefully.
System.Tasking.Utilities.Make_Independent;
-- Environment task gets its own interrupt mask, saves it,
-- and then masks all interrupts except the Keep_Unmasked set.
-- Environment task gets its own interrupt mask, saves it, and then
-- masks all interrupts except the Keep_Unmasked set.
-- During rendezvous, the Interrupt_Manager receives the old
-- interrupt mask of the environment task, and sets its own
-- interrupt mask to that value.
-- During rendezvous, the Interrupt_Manager receives the old interrupt
-- mask of the environment task, and sets its own interrupt mask to that
-- value.
-- The environment task will call the entry of Interrupt_Manager some
-- during elaboration of the body of this package.
@ -728,18 +725,18 @@ package body System.Interrupts is
null;
end Initialize;
-- Note: All tasks in RTS will have all the Reserve Interrupts
-- being masked (except the Interrupt_Manager) and Keep_Unmasked
-- unmasked when created.
-- Note: All tasks in RTS will have all the Reserve Interrupts being
-- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked
-- when created.
-- Abort_Task_Interrupt is one of the Interrupt unmasked
-- in all tasks. We mask the Interrupt in this particular task
-- so that "sigwait" is possible to catch an explicitly sent
-- Abort_Task_Interrupt from the Server_Tasks.
-- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
-- We mask the Interrupt in this particular task so that "sigwait" is
-- possible to catch an explicitly sent Abort_Task_Interrupt from the
-- Server_Tasks.
-- This sigwaiting is needed so that we make sure a Server_Task is
-- out of its own sigwait state. This extra synchronization is
-- necessary to prevent following scenarios.
-- This sigwaiting is needed so that we make sure a Server_Task is out
-- of its own sigwait state. This extra synchronization is necessary to
-- prevent following scenarios.
-- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the
-- Server_Task then changes its own interrupt mask (OS level).
@ -759,6 +756,7 @@ package body System.Interrupts is
declare
Old_Handler : Parameterless_Handler;
begin
select
@ -801,7 +799,7 @@ package body System.Interrupts is
or else User_Entry (Interrupt).T /= Null_Task
then
raise Program_Error with
"A binding for this interrupt is already present";
"a binding for this interrupt is already present";
end if;
-- The interrupt should no longer be ignored if
@ -877,8 +875,8 @@ package body System.Interrupts is
end select;
exception
-- If there is a program error we just want to propagate it
-- to the caller and do not want to stop this task.
-- If there is a program error we just want to propagate it to the
-- caller and do not want to stop this task.
when Program_Error =>
null;
@ -1026,7 +1024,6 @@ package body System.Interrupts is
(Object : access Dynamic_Interrupt_Protection) return Boolean
is
pragma Warnings (Off, Object);
begin
return True;
end Has_Interrupt_Or_Attach_Handler;

168
gcc/ada/s-interr.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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 @@
-- Invariants:
-- All user-handleable interrupts are masked at all times in all
-- tasks/threads except possibly for the Interrupt_Manager task.
-- All user-handleable interrupts are masked at all times in all tasks/threads
-- except possibly for the Interrupt_Manager task.
-- When a user task wants to have the effect of masking/unmasking an
-- interrupt, it must call Block_Interrupt/Unblock_Interrupt, which
-- will have the effect of unmasking/masking the interrupt in the
-- Interrupt_Manager task.
-- When a user task wants to achieve masking/unmasking an interrupt, it must
-- call Block_Interrupt/Unblock_Interrupt, which will have the effect of
-- unmasking/masking the interrupt in the Interrupt_Manager task.
-- Note : Direct calls to sigaction, sigprocmask, pthread_sigsetmask or any
-- other low-level interface that changes the interrupt action or
-- interrupt mask needs a careful thought.
-- One may achieve the effect of system calls first masking RTS blocked
-- (by calling Block_Interrupt) for the interrupt under consideration.
-- This will make all the tasks in RTS blocked for the Interrupt.
-- Once we associate a Server_Task with an interrupt, the task never
-- goes away, and we never remove the association.
-- Once we associate a Server_Task with an interrupt, the task never goes
-- away, and we never remove the association.
-- There is no more than one interrupt per Server_Task and no more than
-- one Server_Task per interrupt.
-- There is no more than one interrupt per Server_Task and no more than one
-- Server_Task per interrupt.
with Ada.Task_Identification;
@ -236,7 +236,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
@ -255,13 +255,13 @@ package body System.Interrupts is
E : Task_Entry_Index;
Int_Ref : System.Address)
is
Interrupt : constant Interrupt_ID :=
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
Interrupt : constant Interrupt_ID :=
Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
@ -275,7 +275,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Block_Interrupt (Interrupt);
@ -291,7 +291,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
-- ??? Since Parameterless_Handler is not Atomic, the current
@ -319,7 +319,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Detach_Handler (Interrupt, Static);
@ -355,7 +355,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Exchange_Handler
@ -385,8 +385,8 @@ package body System.Interrupts is
-- signal to the Server_Task
if not Interrupt_Manager'Terminated
and then State (System.Interrupt_Management.Abort_Task_Interrupt)
/= Default
and then
State (System.Interrupt_Management.Abort_Task_Interrupt) /= Default
then
for N in reverse Object.Previous_Handlers'Range loop
Interrupt_Manager.Attach_Handler
@ -431,7 +431,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Ignore_Interrupt (Interrupt);
@ -488,7 +488,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Blocked (Interrupt);
@ -502,7 +502,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return User_Entry (Interrupt).T /= Null_Task;
@ -516,7 +516,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return User_Handler (Interrupt).H /= null;
@ -530,7 +530,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Ignored (Interrupt);
@ -561,7 +561,6 @@ package body System.Interrupts is
Fat := To_Fat_Ptr (Handler);
Ptr := Registered_Handler_Head;
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
@ -590,11 +589,11 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Storage_Elements.To_Address
(Storage_Elements.Integer_Address (Interrupt));
(Storage_Elements.Integer_Address (Interrupt));
end Reference;
---------------------------------
@ -638,7 +637,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Unblock_Interrupt (Interrupt);
@ -654,7 +653,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Last_Unblocker (Interrupt);
@ -668,7 +667,7 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
raise Program_Error with
"Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
"interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Unignore_Interrupt (Interrupt);
@ -743,13 +742,14 @@ package body System.Interrupts is
procedure Unbind_Handler (Interrupt : Interrupt_ID) is
Server : System.Tasking.Task_Id;
begin
if not Blocked (Interrupt) then
-- Currently, there is a Handler or an Entry attached and
-- corresponding Server_Task is waiting on "sigwait."
-- We have to wake up the Server_Task and make it
-- wait on condition variable by sending an
-- Abort_Task_Interrupt
-- corresponding Server_Task is waiting on "sigwait." We have to
-- wake up the Server_Task and make it wait on condition variable
-- by sending an Abort_Task_Interrupt
Server := Server_ID (Interrupt);
@ -803,11 +803,11 @@ package body System.Interrupts 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).
-- In case we have an Interrupt Entry installed, raise a program
-- error, (propagate it to the caller).
raise Program_Error with
"An interrupt entry is already installed";
"an interrupt entry is already installed";
end if;
-- Note : Static = True will pass the following check. That is the
@ -820,7 +820,7 @@ package body System.Interrupts is
-- raise a program error.
raise Program_Error with
"Trying to detach a static Interrupt Handler";
"trying to detach a static interrupt handler";
end if;
-- The interrupt should no longer be ignored if
@ -854,35 +854,35 @@ package body System.Interrupts 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).
-- In case we have an Interrupt Entry already installed, raise a
-- program error, (propagate it to the caller).
raise Program_Error with
"An interrupt is already installed";
"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.
-- 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.
-- 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
-- Tries to overwrite a static Interrupt Handler with a dynamic
-- Handler
and then (User_Handler (Interrupt).Static
-- The new handler is not specified as an
-- Interrupt Handler by a pragma.
-- The new handler is not specified as an
-- Interrupt Handler by a pragma.
or else not Is_Registered (New_Handler))
or else not Is_Registered (New_Handler))
then
raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
"dynamic Handler";
"trying to overwrite a static Interrupt Handler with a " &
"dynamic handler";
end if;
-- The interrupt should no longer be ignored if
@ -945,12 +945,12 @@ package body System.Interrupts is
System.Tasking.Utilities.Make_Independent;
-- Environment task gets its own interrupt mask, saves it,
-- and then masks all interrupts except the Keep_Unmasked set.
-- Environment task gets its own interrupt mask, saves it, and then
-- masks all interrupts except the Keep_Unmasked set.
-- During rendezvous, the Interrupt_Manager receives the old
-- interrupt mask of the environment task, and sets its own
-- interrupt mask to that value.
-- During rendezvous, the Interrupt_Manager receives the old interrupt
-- mask of the environment task, and sets its own interrupt mask to that
-- value.
-- The environment task will call the entry of Interrupt_Manager some
-- during elaboration of the body of this package.
@ -958,25 +958,24 @@ package body System.Interrupts is
accept Initialize (Mask : IMNG.Interrupt_Mask) do
declare
The_Mask : aliased IMNG.Interrupt_Mask;
begin
IMOP.Copy_Interrupt_Mask (The_Mask, Mask);
IMOP.Set_Interrupt_Mask (The_Mask'Access);
end;
end Initialize;
-- Note: All tasks in RTS will have all the Reserve Interrupts
-- being masked (except the Interrupt_Manager) and Keep_Unmasked
-- unmasked when created.
-- Note: All tasks in RTS will have all the Reserve Interrupts being
-- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked
-- when created.
-- Abort_Task_Interrupt is one of the Interrupt unmasked
-- in all tasks. We mask the Interrupt in this particular task
-- so that "sigwait" is possible to catch an explicitly sent
-- Abort_Task_Interrupt from the Server_Tasks.
-- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
-- We mask the Interrupt in this particular task so that "sigwait" is
-- possible to catch an explicitly sent Abort_Task_Interrupt from the
-- Server_Tasks.
-- This sigwaiting is needed so that we make sure a Server_Task is
-- out of its own sigwait state. This extra synchronization is
-- necessary to prevent following scenarios.
-- This sigwaiting is needed so that we make sure a Server_Task is out
-- of its own sigwait state. This extra synchronization is necessary to
-- prevent following scenarios.
-- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the
-- Server_Task then changes its own interrupt mask (OS level).
@ -1037,14 +1036,14 @@ package body System.Interrupts is
E : Task_Entry_Index;
Interrupt : Interrupt_ID)
do
-- if there is a binding already (either a procedure or an
-- If there is a binding already (either a procedure or an
-- entry), raise Program_Error (propagate it to the caller).
if User_Handler (Interrupt).H /= null
or else User_Entry (Interrupt).T /= Null_Task
then
raise Program_Error with
"A binding for this interrupt is already present";
"a binding for this interrupt is already present";
end if;
-- The interrupt should no longer be ignored if
@ -1118,10 +1117,10 @@ package body System.Interrupts is
if User_Handler (Interrupt).H /= null
or else User_Entry (Interrupt).T /= Null_Task
then
-- This is the case where the Server_Task is waiting
-- on "sigwait." Wake it up by sending an
-- Abort_Task_Interrupt so that the Server_Task
-- waits on Cond.
-- This is the case where the Server_Task is
-- waiting on "sigwait." Wake it up by sending an
-- Abort_Task_Interrupt so that the Server_Task waits
-- on Cond.
POP.Abort_Task (Server_ID (Interrupt));
@ -1158,8 +1157,8 @@ package body System.Interrupts is
else
-- The Server_Task must be waiting on the Cond variable
-- since it was being blocked and an Interrupt Hander or
-- an Entry was there. Wake it up and let it change
-- it place of waiting according to its new state.
-- an Entry was there. Wake it up and let it change it
-- place of waiting according to its new state.
POP.Wakeup (Server_ID (Interrupt),
Interrupt_Server_Blocked_Interrupt_Sleep);
@ -1242,8 +1241,8 @@ package body System.Interrupts is
Tmp_Entry_Index : Task_Entry_Index;
begin
-- By making this task independent of master, when the process
-- goes away, the Server_Task will terminate gracefully.
-- By making this task independent of master, when the process goes
-- away, the Server_Task will terminate gracefully.
System.Tasking.Utilities.Make_Independent;
@ -1262,8 +1261,8 @@ package body System.Interrupts is
-- There are two Interrupt interrupts that this task catch through
-- "sigwait." One is the Interrupt this task is designated to catch
-- in order to execute user handler or entry. The other one is the
-- Abort_Task_Interrupt. This interrupt is being sent from the
-- in order to execute user handler or entry. The other one is
-- the Abort_Task_Interrupt. This interrupt is being sent from the
-- Interrupt_Manager to inform status changes (e.g: become Blocked,
-- Handler or Entry is to be detached).
@ -1303,8 +1302,7 @@ package body System.Interrupts is
elsif Blocked (Interrupt) then
-- Interrupt is blocked. Stay here, so we won't catch
-- the Interrupt.
-- Interrupt is blocked. Stay here, so we won't catch it
Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep);

4
gcc/ada/s-shasto.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2014, 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- --
@ -541,7 +541,7 @@ package body System.Shared_Storage is
when others =>
raise Program_Error with
"Cannot create shared variable file for """ & S & '"';
"cannot create shared variable file for """ & S & '"';
end;
end;

14
gcc/ada/s-tasren.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -367,7 +367,8 @@ package body System.Tasking.Rendezvous is
if System.Tasking.Detect_Blocking
and then STPO.Self.Common.Protected_Action_Nesting > 0
then
raise Program_Error with "potentially blocking operation";
raise Program_Error with
"potentially blocking operation";
end if;
Call_Synchronous
@ -1012,7 +1013,8 @@ package body System.Tasking.Rendezvous is
end if;
Initialization.Undefer_Abort (Self_Id);
raise Program_Error with "Entry call not a delay mode";
raise Program_Error with
"entry call not a delay mode";
end if;
end case;
@ -1316,7 +1318,8 @@ package body System.Tasking.Rendezvous is
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
raise Program_Error with "potentially blocking operation";
raise Program_Error with
"potentially blocking operation";
end if;
if Parameters.Runtime_Traces then
@ -1688,7 +1691,8 @@ package body System.Tasking.Rendezvous is
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
raise Program_Error with "potentially blocking operation";
raise Program_Error with
"potentially blocking operation";
end if;
Initialization.Defer_Abort (Self_Id);

12
gcc/ada/s-tpoben.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2014, 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- --
@ -103,7 +103,7 @@ package body System.Tasking.Protected_Objects.Entries is
STPO.Write_Lock (Object.L'Unrestricted_Access, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
raise Program_Error with "ceiling violation";
end if;
if Single_Lock then
@ -231,7 +231,7 @@ package body System.Tasking.Protected_Objects.Entries is
Lock_Entries_With_Status (Object, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
raise Program_Error with "ceiling violation";
end if;
end Lock_Entries;
@ -245,7 +245,7 @@ package body System.Tasking.Protected_Objects.Entries is
is
begin
if Object.Finalized then
raise Program_Error with "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
@ -305,7 +305,7 @@ package body System.Tasking.Protected_Objects.Entries is
begin
if Object.Finalized then
raise Program_Error with "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
@ -330,7 +330,7 @@ package body System.Tasking.Protected_Objects.Entries is
Read_Lock (Object.L'Access, Ceiling_Violation);
if Ceiling_Violation then
raise Program_Error with "Ceiling Violation";
raise Program_Error with "ceiling violation";
end if;
-- We are entering in a protected action, so that we increase the