summaryrefslogtreecommitdiff
path: root/gcc/ada/s-interr.adb
diff options
context:
space:
mode:
authorbstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4>2008-03-26 20:02:45 +0000
committerbstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4>2008-03-26 20:02:45 +0000
commit261a23bc4f7fbd525cb2f73582743252d2d2f8ac (patch)
treef3c8a991bcf4caac8dd5516247a2d92c9f77ee3b /gcc/ada/s-interr.adb
parent0c164b6eab526a1d0db4a3d08058262ddd476be6 (diff)
downloadgcc-261a23bc4f7fbd525cb2f73582743252d2d2f8ac.tar.gz
2008-03-26 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk r133612 (in particular gcc/Makefile.in with auto dependencies) git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@133613 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/s-interr.adb')
-rw-r--r--gcc/ada/s-interr.adb130
1 files changed, 41 insertions, 89 deletions
diff --git a/gcc/ada/s-interr.adb b/gcc/ada/s-interr.adb
index 6f112826c4a..7b4175eab59 100644
--- a/gcc/ada/s-interr.adb
+++ b/gcc/ada/s-interr.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -55,70 +55,23 @@
-- one Server_Task per interrupt.
with Ada.Task_Identification;
--- used for Task_Id type
-
-with Ada.Exceptions;
--- used for Raise_Exception
with System.Task_Primitives;
--- used for RTS_Lock
--- Self
-
with System.Interrupt_Management;
--- used for Reserve
--- Interrupt_ID
--- Interrupt_Mask
--- Abort_Task_Interrupt
with System.Interrupt_Management.Operations;
--- used for Thread_Block_Interrupt
--- Thread_Unblock_Interrupt
--- Install_Default_Action
--- Install_Ignore_Action
--- Copy_Interrupt_Mask
--- Set_Interrupt_Mask
--- Empty_Interrupt_Mask
--- Fill_Interrupt_Mask
--- Add_To_Interrupt_Mask
--- Delete_From_Interrupt_Mask
--- Interrupt_Wait
--- Interrupt_Self_Process
--- Get_Interrupt_Mask
--- Set_Interrupt_Mask
--- IS_Member
--- Environment_Mask
--- All_Tasks_Mask
pragma Elaborate_All (System.Interrupt_Management.Operations);
with System.Task_Primitives.Operations;
--- used for Write_Lock
--- Unlock
--- Abort
--- Wakeup_Task
--- Sleep
--- Initialize_Lock
-
with System.Task_Primitives.Interrupt_Operations;
--- used for Set_Interrupt_ID
-
with System.Storage_Elements;
--- used for To_Address
--- To_Integer
--- Integer_Address
-
with System.Tasking.Utilities;
--- used for Make_Independent
with System.Tasking.Rendezvous;
--- used for Call_Simple
pragma Elaborate_All (System.Tasking.Rendezvous);
with System.Tasking.Initialization;
--- used for Defer_Abort
--- Undefer_Abort
-
with System.Parameters;
--- used for Single_Lock
with Ada.Unchecked_Conversion;
@@ -126,7 +79,6 @@ package body System.Interrupts is
use Parameters;
use Tasking;
- use Ada.Exceptions;
package POP renames System.Task_Primitives.Operations;
package PIO renames System.Task_Primitives.Interrupt_Operations;
@@ -285,8 +237,8 @@ package body System.Interrupts is
is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
@@ -310,8 +262,8 @@ package body System.Interrupts is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
@@ -324,8 +276,8 @@ package body System.Interrupts is
procedure Block_Interrupt (Interrupt : Interrupt_ID) is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Block_Interrupt (Interrupt);
@@ -340,8 +292,8 @@ package body System.Interrupts is
is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
-- ??? Since Parameterless_Handler is not Atomic, the current
@@ -368,8 +320,8 @@ package body System.Interrupts is
is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Detach_Handler (Interrupt, Static);
@@ -404,8 +356,8 @@ package body System.Interrupts is
is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Exchange_Handler
@@ -464,8 +416,8 @@ package body System.Interrupts is
procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Ignore_Interrupt (Interrupt);
@@ -506,8 +458,8 @@ package body System.Interrupts is
function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Blocked (Interrupt);
@@ -520,8 +472,8 @@ package body System.Interrupts is
function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return User_Entry (Interrupt).T /= Null_Task;
@@ -534,8 +486,8 @@ package body System.Interrupts is
function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return User_Handler (Interrupt).H /= null;
@@ -548,8 +500,8 @@ package body System.Interrupts is
function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Ignored (Interrupt);
@@ -608,8 +560,8 @@ package body System.Interrupts is
function Reference (Interrupt : Interrupt_ID) return System.Address is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Storage_Elements.To_Address
@@ -656,8 +608,8 @@ package body System.Interrupts is
procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Unblock_Interrupt (Interrupt);
@@ -672,8 +624,8 @@ package body System.Interrupts is
is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
return Last_Unblocker (Interrupt);
@@ -686,8 +638,8 @@ package body System.Interrupts is
procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
begin
if Is_Reserved (Interrupt) then
- Raise_Exception (Program_Error'Identity, "Interrupt" &
- Interrupt_ID'Image (Interrupt) & " is reserved");
+ raise Program_Error with
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
end if;
Interrupt_Manager.Unignore_Interrupt (Interrupt);
@@ -825,8 +777,8 @@ package body System.Interrupts is
-- In case we have an Interrupt Entry installed.
-- raise a program error. (propagate it to the caller).
- Raise_Exception (Program_Error'Identity,
- "An interrupt entry is already installed");
+ raise Program_Error with
+ "An interrupt entry is already installed";
end if;
-- Note : Static = True will pass the following check. That is the
@@ -838,8 +790,8 @@ package body System.Interrupts is
-- Tries to detach a static Interrupt Handler.
-- raise a program error.
- Raise_Exception (Program_Error'Identity,
- "Trying to detach a static Interrupt Handler");
+ raise Program_Error with
+ "Trying to detach a static Interrupt Handler";
end if;
-- The interrupt should no longer be ignored if
@@ -876,8 +828,8 @@ package body System.Interrupts is
-- In case we have an Interrupt Entry already installed.
-- raise a program error. (propagate it to the caller).
- Raise_Exception (Program_Error'Identity,
- "An interrupt is already installed");
+ raise Program_Error with
+ "An interrupt is already installed";
end if;
-- Note : A null handler with Static = True will pass the
@@ -899,9 +851,9 @@ package body System.Interrupts is
or else not Is_Registered (New_Handler))
then
- Raise_Exception (Program_Error'Identity,
+ raise Program_Error with
"Trying to overwrite a static Interrupt Handler with a " &
- "dynamic Handler");
+ "dynamic Handler";
end if;
-- The interrupt should no longer be ingnored if
@@ -1062,8 +1014,8 @@ package body System.Interrupts is
if User_Handler (Interrupt).H /= null
or else User_Entry (Interrupt).T /= Null_Task
then
- Raise_Exception (Program_Error'Identity,
- "A binding for this interrupt is already present");
+ raise Program_Error with
+ "A binding for this interrupt is already present";
end if;
-- The interrupt should no longer be ingnored if