+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
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
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;
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
--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
-- --
-- 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- --
-- 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;
-- 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);
(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));
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.
-- 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 --
--------------------
-- 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;
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);
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;
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;
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);
----------------------
-- 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;
procedure Finalize_Interrupt_Servers is
HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
-
begin
if HW_Interrupts then
for Int in HW_Interrupt loop
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;
Fat := To_Fat_Ptr (Handler);
Ptr := Registered_Handler_Head;
-
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
-- 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);
begin
Check_Reserved_Interrupt (Interrupt);
return Storage_Elements.To_Address
- (Storage_Elements.Integer_Address (Interrupt));
+ (Storage_Elements.Integer_Address (Interrupt));
end Reference;
--------------------------------
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);
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;
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;
-----------------------
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.
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));
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
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;
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
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
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;
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
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);
-- --
-- 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- --
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);
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;
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;
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;
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
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);
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) :=
Fat := To_Fat_Ptr (Handler);
while Ptr /= null loop
-
if Ptr.H = Fat.Handler_Addr then
return True;
end if;
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
-- --
-- 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- --
Static : Boolean);
entry Detach_Handler
- (Interrupt : Interrupt_ID;
- Static : Boolean);
+ (Interrupt : Interrupt_ID;
+ Static : Boolean);
entry Bind_Interrupt_To_Entry
(T : Task_Id;
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);
-- 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;
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);
Fat := To_Fat_Ptr (Handler);
Ptr := Registered_Handler_Head;
-
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
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;
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;
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);
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);
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
--------------------
-- 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.
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;
----------------------
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;
--------------------
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);
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;
-----------------------------
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;
------------------------------
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);
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);
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);
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);
-- 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
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
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
-- 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
-- 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.
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).
declare
Old_Handler : Parameterless_Handler;
+
begin
select
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
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;
(Object : access Dynamic_Interrupt_Protection) return Boolean
is
pragma Warnings (Off, Object);
-
begin
return True;
end Has_Interrupt_Or_Attach_Handler;
-- --
-- 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- --
-- 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;
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);
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);
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);
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
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);
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
-- 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
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);
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);
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;
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;
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);
Fat := To_Fat_Ptr (Handler);
Ptr := Registered_Handler_Head;
-
while Ptr /= null loop
if Ptr.H = Fat.Handler_Addr then
return True;
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;
---------------------------------
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);
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);
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);
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);
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
-- 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
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
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.
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).
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
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));
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);
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;
-- 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).
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);
-- --
-- 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- --
when others =>
raise Program_Error with
- "Cannot create shared variable file for """ & S & '"';
+ "cannot create shared variable file for """ & S & '"';
end;
end;
-- --
-- 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- --
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
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;
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
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);
-- --
-- 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- --
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
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;
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
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
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
projects / gcc.git / commitdiff