diff options
Diffstat (limited to 'gcc/ada/5vinterr.adb')
| -rw-r--r-- | gcc/ada/5vinterr.adb | 137 |
1 files changed, 73 insertions, 64 deletions
diff --git a/gcc/ada/5vinterr.adb b/gcc/ada/5vinterr.adb index c32dd9938c5..2f78912d8c6 100644 --- a/gcc/ada/5vinterr.adb +++ b/gcc/ada/5vinterr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2003, 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- -- @@ -27,7 +27,7 @@ -- covered by the GNU Public License. -- -- -- -- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- -- -- ------------------------------------------------------------------------------ @@ -128,7 +128,6 @@ package body System.Interrupts is use System.Parameters; use Ada.Exceptions; - package PRI renames System.Task_Primitives; package POP renames System.Task_Primitives.Operations; package PIO renames System.Task_Primitives.Interrupt_Operations; package IMNG renames System.Interrupt_Management; @@ -151,20 +150,20 @@ package body System.Interrupts is entry Initialize (Mask : IMNG.Interrupt_Mask); entry Attach_Handler - (New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean; - Restoration : in Boolean := False); + (New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean; + Restoration : Boolean := False); entry Exchange_Handler (Old_Handler : out Parameterless_Handler; - New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean); + New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean); entry Detach_Handler - (Interrupt : in Interrupt_ID; - Static : in Boolean); + (Interrupt : Interrupt_ID; + Static : Boolean); entry Bind_Interrupt_To_Entry (T : Task_ID; @@ -184,6 +183,11 @@ package body System.Interrupts is task type Server_Task (Interrupt : Interrupt_ID) is pragma Priority (System.Interrupt_Priority'Last); + -- Note: the above pragma Priority is strictly speaking improper + -- since it is outside the range of allowed priorities, but the + -- compiler treats system units specially and does not apply + -- this range checking rule to system units. + end Server_Task; type Server_Task_Access is access Server_Task; @@ -429,9 +433,9 @@ package body System.Interrupts is -- can detach handlers attached through pragma Attach_Handler. procedure Attach_Handler - (New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean := False) is + (New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean := False) is begin if Is_Reserved (Interrupt) then Raise_Exception (Program_Error'Identity, "Interrupt" & @@ -456,9 +460,9 @@ package body System.Interrupts is procedure Exchange_Handler (Old_Handler : out Parameterless_Handler; - New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean := False) is + New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean := False) is begin if Is_Reserved (Interrupt) then Raise_Exception (Program_Error'Identity, "Interrupt" & @@ -482,8 +486,9 @@ package body System.Interrupts is -- detach handlers attached through pragma Attach_Handler. procedure Detach_Handler - (Interrupt : in Interrupt_ID; - Static : in Boolean := False) is + (Interrupt : Interrupt_ID; + Static : Boolean := False) + is begin if Is_Reserved (Interrupt) then Raise_Exception (Program_Error'Identity, "Interrupt" & @@ -621,28 +626,19 @@ package body System.Interrupts is task body Interrupt_Manager is --------------------- - -- Local Variables -- - --------------------- - - Intwait_Mask : aliased IMNG.Interrupt_Mask; - Ret_Interrupt : Interrupt_ID; - Old_Mask : aliased IMNG.Interrupt_Mask; - Self_ID : Task_ID := POP.Self; - - --------------------- -- Local Routines -- --------------------- procedure Unprotected_Exchange_Handler (Old_Handler : out Parameterless_Handler; - New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean; - Restoration : in Boolean := False); + New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean; + Restoration : Boolean := False); procedure Unprotected_Detach_Handler - (Interrupt : in Interrupt_ID; - Static : in Boolean); + (Interrupt : Interrupt_ID; + Static : Boolean); ---------------------------------- -- Unprotected_Exchange_Handler -- @@ -650,10 +646,11 @@ package body System.Interrupts is procedure Unprotected_Exchange_Handler (Old_Handler : out Parameterless_Handler; - New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean; - Restoration : in Boolean := False) is + New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean; + Restoration : Boolean := False) + is begin if User_Entry (Interrupt).T /= Null_Task then -- In case we have an Interrupt Entry already installed. @@ -726,8 +723,8 @@ package body System.Interrupts is -------------------------------- procedure Unprotected_Detach_Handler - (Interrupt : in Interrupt_ID; - Static : in Boolean) + (Interrupt : Interrupt_ID; + Static : Boolean) is Old_Handler : Parameterless_Handler; @@ -786,6 +783,7 @@ package body System.Interrupts is -- during elaboration of the body of this package. accept Initialize (Mask : IMNG.Interrupt_Mask) do + pragma Warnings (Off, Mask); null; end Initialize; @@ -795,7 +793,7 @@ package body System.Interrupts is -- 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 + -- so that "sigwait" is possible to catch an explicitely sent -- Abort_Task_Interrupt from the Server_Tasks. -- This sigwaiting is needed so that we make sure a Server_Task is @@ -824,10 +822,10 @@ package body System.Interrupts is select accept Attach_Handler - (New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean; - Restoration : in Boolean := False) + (New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean; + Restoration : Boolean := False) do Unprotected_Exchange_Handler (Old_Handler, New_Handler, Interrupt, Static, Restoration); @@ -835,17 +833,17 @@ package body System.Interrupts is or accept Exchange_Handler (Old_Handler : out Parameterless_Handler; - New_Handler : in Parameterless_Handler; - Interrupt : in Interrupt_ID; - Static : in Boolean) + New_Handler : Parameterless_Handler; + Interrupt : Interrupt_ID; + Static : Boolean) do Unprotected_Exchange_Handler (Old_Handler, New_Handler, Interrupt, Static); end Exchange_Handler; or accept Detach_Handler - (Interrupt : in Interrupt_ID; - Static : in Boolean) + (Interrupt : Interrupt_ID; + Static : Boolean) do Unprotected_Detach_Handler (Interrupt, Static); end Detach_Handler; @@ -869,7 +867,7 @@ package body System.Interrupts is -- it was ever ignored. Ignored (Interrupt) := False; - User_Entry (Interrupt) := Entry_Assoc' (T => T, E => E); + User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E); -- Indicate the attachment of Interrupt Entry in ATCB. -- This is need so that when an Interrupt Entry task @@ -895,17 +893,17 @@ package body System.Interrupts is or accept Detach_Interrupt_Entries (T : Task_ID) do - for I in Interrupt_ID'Range loop - if not Is_Reserved (I) then - if User_Entry (I).T = T then + for J in Interrupt_ID'Range loop + if not Is_Reserved (J) then + if User_Entry (J).T = T then -- The interrupt should no longer be ignored if -- it was ever ignored. - Ignored (I) := False; - User_Entry (I) := Entry_Assoc' - (T => Null_Task, E => Null_Task_Entry); - IMOP.Interrupt_Self_Process (IMNG.Interrupt_ID (I)); + Ignored (J) := False; + User_Entry (J) := + Entry_Assoc'(T => Null_Task, E => Null_Task_Entry); + IMOP.Interrupt_Self_Process (IMNG.Interrupt_ID (J)); end if; end if; end loop; @@ -916,18 +914,22 @@ package body System.Interrupts is end Detach_Interrupt_Entries; or accept Block_Interrupt (Interrupt : Interrupt_ID) do + pragma Warnings (Off, Interrupt); raise Program_Error; end Block_Interrupt; or accept Unblock_Interrupt (Interrupt : Interrupt_ID) do + pragma Warnings (Off, Interrupt); raise Program_Error; end Unblock_Interrupt; or accept Ignore_Interrupt (Interrupt : Interrupt_ID) do + pragma Warnings (Off, Interrupt); raise Program_Error; end Ignore_Interrupt; or accept Unignore_Interrupt (Interrupt : Interrupt_ID) do + pragma Warnings (Off, Interrupt); raise Program_Error; end Unignore_Interrupt; @@ -1033,12 +1035,13 @@ package body System.Interrupts is end if; Tmp_Handler.all; - POP.Write_Lock (Self_ID); if Single_Lock then POP.Lock_RTS; end if; + POP.Write_Lock (Self_ID); + elsif User_Entry (Interrupt).T /= Null_Task then Tmp_ID := User_Entry (Interrupt).T; Tmp_Entry_Index := User_Entry (Interrupt).E; @@ -1054,11 +1057,11 @@ package body System.Interrupts is System.Tasking.Rendezvous.Call_Simple (Tmp_ID, Tmp_Entry_Index, System.Null_Address); - POP.Write_Lock (Self_ID); - if Single_Lock then POP.Lock_RTS; end if; + + POP.Write_Lock (Self_ID); end if; end if; end if; @@ -1081,7 +1084,11 @@ package body System.Interrupts is ------------------------------------- function Has_Interrupt_Or_Attach_Handler - (Object : access Dynamic_Interrupt_Protection) return Boolean is + (Object : access Dynamic_Interrupt_Protection) + return Boolean + is + pragma Warnings (Off, Object); + begin return True; end Has_Interrupt_Or_Attach_Handler; @@ -1116,6 +1123,7 @@ package body System.Interrupts is (Object : access Static_Interrupt_Protection) return Boolean is + pragma Warnings (Off, Object); begin return True; end Has_Interrupt_Or_Attach_Handler; @@ -1126,7 +1134,8 @@ package body System.Interrupts is procedure Install_Handlers (Object : access Static_Interrupt_Protection; - New_Handlers : in New_Handler_Array) is + New_Handlers : New_Handler_Array) + is begin for N in New_Handlers'Range loop |