diff options
| -rw-r--r-- | gcc/ada/libgnarl/s-interr.adb | 36 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-interr__hwint.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-interr__sigaction.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/libgnarl/s-interr__vxworks.adb | 34 |
4 files changed, 56 insertions, 70 deletions
diff --git a/gcc/ada/libgnarl/s-interr.adb b/gcc/ada/libgnarl/s-interr.adb index d28c8f9..7a23168 100644 --- a/gcc/ada/libgnarl/s-interr.adb +++ b/gcc/ada/libgnarl/s-interr.adb @@ -187,20 +187,23 @@ package body System.Interrupts is -- needed to accomplish locking per Interrupt base. Also is needed to -- 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. + -- Type and the list containing Registered Interrupt Handlers. These + -- definitions are used to register the handlers specified by the pragma + -- Interrupt_Handler. + + -------------------------- + -- Handler Registration -- + -------------------------- type Registered_Handler; type R_Link is access all Registered_Handler; type Registered_Handler is record - H : System.Address := System.Null_Address; - Next : R_Link := null; + H : System.Address; + Next : R_Link; end record; - Registered_Handler_Head : R_Link := null; - Registered_Handler_Tail : R_Link := null; + Registered_Handlers : R_Link := null; Access_Hold : Server_Task_Access; -- Variable used to allocate Server_Task using "new" @@ -254,7 +257,6 @@ package body System.Interrupts is is Interrupt : constant Interrupt_ID := Interrupt_ID (Storage_Elements.To_Integer (Int_Ref)); - begin if Is_Reserved (Interrupt) then raise Program_Error with @@ -538,6 +540,7 @@ package body System.Interrupts is ------------------- function Is_Registered (Handler : Parameterless_Handler) return Boolean is + Ptr : R_Link := Registered_Handlers; type Acc_Proc is access procedure; @@ -549,7 +552,6 @@ package body System.Interrupts is function To_Fat_Ptr is new Ada.Unchecked_Conversion (Parameterless_Handler, Fat_Ptr); - Ptr : R_Link; Fat : Fat_Ptr; begin @@ -559,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.all'Address then return True; @@ -600,8 +601,6 @@ package body System.Interrupts is --------------------------------- procedure Register_Interrupt_Handler (Handler_Addr : System.Address) 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 @@ -615,17 +614,8 @@ package body System.Interrupts is pragma Assert (Handler_Addr /= System.Null_Address); - New_Node_Ptr := new Registered_Handler; - New_Node_Ptr.H := Handler_Addr; - - 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; - end if; + Registered_Handlers := + new Registered_Handler'(H => Handler_Addr, Next => Registered_Handlers); end Register_Interrupt_Handler; ----------------------- diff --git a/gcc/ada/libgnarl/s-interr__hwint.adb b/gcc/ada/libgnarl/s-interr__hwint.adb index 4410835..dcac8e8 100644 --- a/gcc/ada/libgnarl/s-interr__hwint.adb +++ b/gcc/ada/libgnarl/s-interr__hwint.adb @@ -141,20 +141,23 @@ package body System.Interrupts is pragma Volatile_Components (User_Entry); -- Holds the task and entry index (if any) for each interrupt - -- 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. + -- Type and the list containing Registered Interrupt Handlers. These + -- definitions are used to register the handlers specified by the pragma + -- Interrupt_Handler. + + -------------------------- + -- Handler Registration -- + -------------------------- type Registered_Handler; type R_Link is access all Registered_Handler; type Registered_Handler is record - H : System.Address := System.Null_Address; - Next : R_Link := null; + H : System.Address; + Next : R_Link; end record; - Registered_Handler_Head : R_Link := null; - Registered_Handler_Tail : R_Link := null; + Registered_Handlers : R_Link := null; Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id := (others => System.Tasking.Null_Task); @@ -543,6 +546,7 @@ package body System.Interrupts is ------------------- function Is_Registered (Handler : Parameterless_Handler) return Boolean is + Ptr : R_Link := Registered_Handlers; type Acc_Proc is access procedure; @@ -554,7 +558,6 @@ package body System.Interrupts is function To_Fat_Ptr is new Ada.Unchecked_Conversion (Parameterless_Handler, Fat_Ptr); - Ptr : R_Link; Fat : Fat_Ptr; begin @@ -564,7 +567,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.all'Address then return True; @@ -635,8 +637,6 @@ package body System.Interrupts is -------------------------------- procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is - New_Node_Ptr : R_Link; - begin -- This routine registers a handler as usable for dynamic interrupt -- handler association. Routines attaching and detaching handlers @@ -650,16 +650,8 @@ package body System.Interrupts is pragma Assert (Handler_Addr /= System.Null_Address); - New_Node_Ptr := new Registered_Handler; - New_Node_Ptr.H := Handler_Addr; - - 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; - end if; + Registered_Handlers := + new Registered_Handler'(H => Handler_Addr, Next => Registered_Handlers); end Register_Interrupt_Handler; ----------------------- diff --git a/gcc/ada/libgnarl/s-interr__sigaction.adb b/gcc/ada/libgnarl/s-interr__sigaction.adb index 9691674..c0398e4 100644 --- a/gcc/ada/libgnarl/s-interr__sigaction.adb +++ b/gcc/ada/libgnarl/s-interr__sigaction.adb @@ -91,9 +91,9 @@ package body System.Interrupts is pragma Convention (C, Signal_Handler); -- This procedure is used to handle all the signals - -- 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. + -- Type and the list containing Registered Interrupt Handlers. These + -- definitions are used to register the handlers specified by the pragma + -- Interrupt_Handler. -------------------------- -- Handler Registration -- @@ -103,8 +103,8 @@ package body System.Interrupts is type R_Link is access all Registered_Handler; type Registered_Handler is record - H : System.Address := System.Null_Address; - Next : R_Link := null; + H : System.Address; + Next : R_Link; end record; Registered_Handlers : R_Link := null; @@ -471,6 +471,18 @@ package body System.Interrupts is procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is 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. + + -- 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); + Registered_Handlers := new Registered_Handler'(H => Handler_Addr, Next => Registered_Handlers); end Register_Interrupt_Handler; diff --git a/gcc/ada/libgnarl/s-interr__vxworks.adb b/gcc/ada/libgnarl/s-interr__vxworks.adb index 329020d..aade352 100644 --- a/gcc/ada/libgnarl/s-interr__vxworks.adb +++ b/gcc/ada/libgnarl/s-interr__vxworks.adb @@ -164,20 +164,23 @@ package body System.Interrupts is pragma Volatile_Components (User_Entry); -- Holds the task and entry index (if any) for each interrupt / signal - -- 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. + -- Type and the list containing Registered Interrupt Handlers. These + -- definitions are used to register the handlers specified by the pragma + -- Interrupt_Handler. + + -------------------------- + -- Handler Registration -- + -------------------------- type Registered_Handler; type R_Link is access all Registered_Handler; type Registered_Handler is record - H : System.Address := System.Null_Address; - Next : R_Link := null; + H : System.Address; + Next : R_Link; end record; - Registered_Handler_Head : R_Link := null; - Registered_Handler_Tail : R_Link := null; + Registered_Handlers : R_Link := null; Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id := (others => System.Tasking.Null_Task); @@ -583,6 +586,7 @@ package body System.Interrupts is ------------------- function Is_Registered (Handler : Parameterless_Handler) return Boolean is + Ptr : R_Link := Registered_Handlers; type Acc_Proc is access procedure; @@ -594,7 +598,6 @@ package body System.Interrupts is function To_Fat_Ptr is new Ada.Unchecked_Conversion (Parameterless_Handler, Fat_Ptr); - Ptr : R_Link; Fat : Fat_Ptr; begin @@ -604,7 +607,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.all'Address then return True; @@ -675,8 +677,6 @@ package body System.Interrupts is -------------------------------- procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is - New_Node_Ptr : R_Link; - begin -- This routine registers a handler as usable for dynamic interrupt -- handler association. Routines attaching and detaching handlers @@ -690,16 +690,8 @@ package body System.Interrupts is pragma Assert (Handler_Addr /= System.Null_Address); - New_Node_Ptr := new Registered_Handler; - New_Node_Ptr.H := Handler_Addr; - - 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; - end if; + Registered_Handlers := + new Registered_Handler'(H => Handler_Addr, Next => Registered_Handlers); end Register_Interrupt_Handler; ----------------------- |