diff options
Diffstat (limited to 'gcc-4.4.0/gcc/ada/s-taasde.adb')
-rw-r--r-- | gcc-4.4.0/gcc/ada/s-taasde.adb | 412 |
1 files changed, 0 insertions, 412 deletions
diff --git a/gcc-4.4.0/gcc/ada/s-taasde.adb b/gcc-4.4.0/gcc/ada/s-taasde.adb deleted file mode 100644 index 315d9ba13..000000000 --- a/gcc-4.4.0/gcc/ada/s-taasde.adb +++ /dev/null @@ -1,412 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2009, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - -pragma Polling (Off); --- Turn off polling, we do not want ATC polling to take place during --- tasking operations. It causes infinite loops and other problems. - -with Ada.Unchecked_Conversion; -with Ada.Task_Identification; - -with System.Task_Primitives.Operations; -with System.Tasking.Utilities; -with System.Tasking.Initialization; -with System.Tasking.Debug; -with System.OS_Primitives; -with System.Interrupt_Management.Operations; -with System.Parameters; -with System.Traces.Tasking; - -package body System.Tasking.Async_Delays is - - package STPO renames System.Task_Primitives.Operations; - package ST renames System.Tasking; - package STU renames System.Tasking.Utilities; - package STI renames System.Tasking.Initialization; - package OSP renames System.OS_Primitives; - - use Parameters; - use System.Traces; - use System.Traces.Tasking; - - function To_System is new Ada.Unchecked_Conversion - (Ada.Task_Identification.Task_Id, Task_Id); - - Timer_Server_ID : ST.Task_Id; - - Timer_Attention : Boolean := False; - pragma Atomic (Timer_Attention); - - task Timer_Server is - pragma Interrupt_Priority (System.Any_Priority'Last); - end Timer_Server; - - -- The timer queue is a circular doubly linked list, ordered by absolute - -- wakeup time. The first item in the queue is Timer_Queue.Succ. - -- It is given a Resume_Time that is larger than any legitimate wakeup - -- time, so that the ordered insertion will always stop searching when it - -- gets back to the queue header block. - - Timer_Queue : aliased Delay_Block; - - ------------------------ - -- Cancel_Async_Delay -- - ------------------------ - - -- This should (only) be called from the compiler-generated cleanup routine - -- for an async. select statement with delay statement as trigger. The - -- effect should be to remove the delay from the timer queue, and exit one - -- ATC nesting level. - -- The usage and logic are similar to Cancel_Protected_Entry_Call, but - -- simplified because this is not a true entry call. - - procedure Cancel_Async_Delay (D : Delay_Block_Access) is - Dpred : Delay_Block_Access; - Dsucc : Delay_Block_Access; - - begin - -- Note that we mark the delay as being cancelled - -- using a level value that is reserved. - - -- make this operation idempotent - - if D.Level = ATC_Level_Infinity then - return; - end if; - - D.Level := ATC_Level_Infinity; - - -- remove self from timer queue - - STI.Defer_Abort_Nestable (D.Self_Id); - - if Single_Lock then - STPO.Lock_RTS; - end if; - - STPO.Write_Lock (Timer_Server_ID); - Dpred := D.Pred; - Dsucc := D.Succ; - Dpred.Succ := Dsucc; - Dsucc.Pred := Dpred; - D.Succ := D; - D.Pred := D; - STPO.Unlock (Timer_Server_ID); - - -- Note that the above deletion code is required to be - -- idempotent, since the block may have been dequeued - -- previously by the Timer_Server. - - -- leave the asynchronous select - - STPO.Write_Lock (D.Self_Id); - STU.Exit_One_ATC_Level (D.Self_Id); - STPO.Unlock (D.Self_Id); - - if Single_Lock then - STPO.Unlock_RTS; - end if; - - STI.Undefer_Abort_Nestable (D.Self_Id); - end Cancel_Async_Delay; - - --------------------------- - -- Enqueue_Time_Duration -- - --------------------------- - - function Enqueue_Duration - (T : Duration; - D : Delay_Block_Access) return Boolean - is - begin - if T <= 0.0 then - D.Timed_Out := True; - STPO.Yield; - return False; - - else - -- The corresponding call to Undefer_Abort is performed by the - -- expanded code (see exp_ch9). - - STI.Defer_Abort (STPO.Self); - Time_Enqueue - (STPO.Monotonic_Clock - + Duration'Min (T, OSP.Max_Sensible_Delay), D); - return True; - end if; - end Enqueue_Duration; - - ------------------ - -- Time_Enqueue -- - ------------------ - - -- Allocate a queue element for the wakeup time T and put it in the - -- queue in wakeup time order. Assume we are on an asynchronous - -- select statement with delay trigger. Put the calling task to - -- sleep until either the delay expires or is cancelled. - - -- We use one entry call record for this delay, since we have - -- to increment the ATC nesting level, but since it is not a - -- real entry call we do not need to use any of the fields of - -- the call record. The following code implements a subset of - -- the actions for the asynchronous case of Protected_Entry_Call, - -- much simplified since we know this never blocks, and does not - -- have the full semantics of a protected entry call. - - procedure Time_Enqueue - (T : Duration; - D : Delay_Block_Access) - is - Self_Id : constant Task_Id := STPO.Self; - Q : Delay_Block_Access; - - use type ST.Task_Id; - -- for visibility of operator "=" - - begin - pragma Debug (Debug.Trace (Self_Id, "Async_Delay", 'P')); - pragma Assert (Self_Id.Deferral_Level = 1, - "async delay from within abort-deferred region"); - - if Self_Id.ATC_Nesting_Level = ATC_Level'Last then - raise Storage_Error with "not enough ATC nesting levels"; - end if; - - Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1; - - pragma Debug - (Debug.Trace (Self_Id, "ASD: entered ATC level: " & - ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A')); - - D.Level := Self_Id.ATC_Nesting_Level; - D.Self_Id := Self_Id; - D.Resume_Time := T; - - if Single_Lock then - STPO.Lock_RTS; - end if; - - STPO.Write_Lock (Timer_Server_ID); - - -- Previously, there was code here to dynamically create - -- the Timer_Server task, if one did not already exist. - -- That code had a timing window that could allow multiple - -- timer servers to be created. Luckily, the need for - -- postponing creation of the timer server should now be - -- gone, since this package will only be linked in if - -- there are calls to enqueue calls on the timer server. - - -- Insert D in the timer queue, at the position determined - -- by the wakeup time T. - - Q := Timer_Queue.Succ; - - while Q.Resume_Time < T loop - Q := Q.Succ; - end loop; - - -- Q is the block that has Resume_Time equal to or greater than - -- T. After the insertion we want Q to be the successor of D. - - D.Succ := Q; - D.Pred := Q.Pred; - D.Pred.Succ := D; - Q.Pred := D; - - -- If the new element became the head of the queue, - -- signal the Timer_Server to wake up. - - if Timer_Queue.Succ = D then - Timer_Attention := True; - STPO.Wakeup (Timer_Server_ID, ST.Timer_Server_Sleep); - end if; - - STPO.Unlock (Timer_Server_ID); - - if Single_Lock then - STPO.Unlock_RTS; - end if; - end Time_Enqueue; - - --------------- - -- Timed_Out -- - --------------- - - function Timed_Out (D : Delay_Block_Access) return Boolean is - begin - return D.Timed_Out; - end Timed_Out; - - ------------------ - -- Timer_Server -- - ------------------ - - task body Timer_Server is - function Get_Next_Wakeup_Time return Duration; - -- Used to initialize Next_Wakeup_Time, but also to ensure that - -- Make_Independent is called during the elaboration of this task. - - -------------------------- - -- Get_Next_Wakeup_Time -- - -------------------------- - - function Get_Next_Wakeup_Time return Duration is - begin - STU.Make_Independent; - return Duration'Last; - end Get_Next_Wakeup_Time; - - -- Local Declarations - - Next_Wakeup_Time : Duration := Get_Next_Wakeup_Time; - Timedout : Boolean; - Yielded : Boolean; - Now : Duration; - Dequeued : Delay_Block_Access; - Dequeued_Task : Task_Id; - - pragma Unreferenced (Timedout, Yielded); - - begin - Timer_Server_ID := STPO.Self; - - -- Since this package may be elaborated before System.Interrupt, - -- we need to call Setup_Interrupt_Mask explicitly to ensure that - -- this task has the proper signal mask. - - Interrupt_Management.Operations.Setup_Interrupt_Mask; - - -- Initialize the timer queue to empty, and make the wakeup time of the - -- header node be larger than any real wakeup time we will ever use. - - loop - STI.Defer_Abort (Timer_Server_ID); - - if Single_Lock then - STPO.Lock_RTS; - end if; - - STPO.Write_Lock (Timer_Server_ID); - - -- The timer server needs to catch pending aborts after finalization - -- of library packages. If it doesn't poll for it, the server will - -- sometimes hang. - - if not Timer_Attention then - Timer_Server_ID.Common.State := ST.Timer_Server_Sleep; - - if Next_Wakeup_Time = Duration'Last then - Timer_Server_ID.User_State := 1; - Next_Wakeup_Time := - STPO.Monotonic_Clock + OSP.Max_Sensible_Delay; - - else - Timer_Server_ID.User_State := 2; - end if; - - STPO.Timed_Sleep - (Timer_Server_ID, Next_Wakeup_Time, - OSP.Absolute_RT, ST.Timer_Server_Sleep, - Timedout, Yielded); - Timer_Server_ID.Common.State := ST.Runnable; - end if; - - -- Service all of the wakeup requests on the queue whose times have - -- been reached, and update Next_Wakeup_Time to next wakeup time - -- after that (the wakeup time of the head of the queue if any, else - -- a time far in the future). - - Timer_Server_ID.User_State := 3; - Timer_Attention := False; - - Now := STPO.Monotonic_Clock; - while Timer_Queue.Succ.Resume_Time <= Now loop - - -- Dequeue the waiting task from the front of the queue - - pragma Debug (System.Tasking.Debug.Trace - (Timer_Server_ID, "Timer service: waking up waiting task", 'E')); - - Dequeued := Timer_Queue.Succ; - Timer_Queue.Succ := Dequeued.Succ; - Dequeued.Succ.Pred := Dequeued.Pred; - Dequeued.Succ := Dequeued; - Dequeued.Pred := Dequeued; - - -- We want to abort the queued task to the level of the async. - -- select statement with the delay. To do that, we need to lock - -- the ATCB of that task, but to avoid deadlock we need to release - -- the lock of the Timer_Server. This leaves a window in which - -- another task might perform an enqueue or dequeue operation on - -- the timer queue, but that is OK because we always restart the - -- next iteration at the head of the queue. - - if Parameters.Runtime_Traces then - Send_Trace_Info (E_Kill, Dequeued.Self_Id); - end if; - - STPO.Unlock (Timer_Server_ID); - STPO.Write_Lock (Dequeued.Self_Id); - Dequeued_Task := Dequeued.Self_Id; - Dequeued.Timed_Out := True; - STI.Locked_Abort_To_Level - (Timer_Server_ID, Dequeued_Task, Dequeued.Level - 1); - STPO.Unlock (Dequeued_Task); - STPO.Write_Lock (Timer_Server_ID); - end loop; - - Next_Wakeup_Time := Timer_Queue.Succ.Resume_Time; - - -- Service returns the Next_Wakeup_Time. - -- The Next_Wakeup_Time is either an infinity (no delay request) - -- or the wakeup time of the queue head. This value is used for - -- an actual delay in this server. - - STPO.Unlock (Timer_Server_ID); - - if Single_Lock then - STPO.Unlock_RTS; - end if; - - STI.Undefer_Abort (Timer_Server_ID); - end loop; - end Timer_Server; - - ------------------------------ - -- Package Body Elaboration -- - ------------------------------ - -begin - Timer_Queue.Succ := Timer_Queue'Access; - Timer_Queue.Pred := Timer_Queue'Access; - Timer_Queue.Resume_Time := Duration'Last; - Timer_Server_ID := To_System (Timer_Server'Identity); -end System.Tasking.Async_Delays; |