diff options
author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-03-26 20:02:45 +0000 |
---|---|---|
committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-03-26 20:02:45 +0000 |
commit | 261a23bc4f7fbd525cb2f73582743252d2d2f8ac (patch) | |
tree | f3c8a991bcf4caac8dd5516247a2d92c9f77ee3b /gcc/ada/s-interr.adb | |
parent | 0c164b6eab526a1d0db4a3d08058262ddd476be6 (diff) | |
download | gcc-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.adb | 130 |
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 |