diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/s-taasde.ads')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/s-taasde.ads | 151 |
1 files changed, 151 insertions, 0 deletions
diff --git a/gcc-4.2.1/gcc/ada/s-taasde.ads b/gcc-4.2.1/gcc/ada/s-taasde.ads new file mode 100644 index 000000000..4eecabff5 --- /dev/null +++ b/gcc-4.2.1/gcc/ada/s-taasde.ads @@ -0,0 +1,151 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1998-2006, 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 2, or (at your option) any later ver- -- +-- sion. GNARL 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- 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. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains the procedures to implements timeouts (delays) for +-- asynchronous select statements. + +-- Note: the compiler generates direct calls to this interface, via Rtsfind. +-- Any changes to this interface may require corresponding compiler changes. + +package System.Tasking.Async_Delays is + + -- Suppose the following source code is given: + + -- select delay When; + -- ...continuation for timeout case... + -- then abort + -- ...abortable part... + -- end select; + + -- The compiler should expand this to the following: + + -- declare + -- DB : aliased Delay_Block; + -- begin + -- if System.Tasking.Async_Delays.Enqueue_Duration + -- (When, DB'Unchecked_Access) + -- then + -- begin + -- A101b : declare + -- procedure _clean is + -- begin + -- System.Tasking.Async_Delays.Cancel_Async_Delay + -- (DB'Unchecked_Access); + -- return; + -- end _clean; + -- begin + -- abort_undefer.all; + -- ...abortable part... + -- exception + -- when all others => + -- declare + -- E105b : exception_occurrence; + -- begin + -- save_occurrence (E105b, get_current_excep.all.all); + -- _clean; + -- reraise_occurrence_no_defer (E105b); + -- end; + -- at end + -- _clean; + -- end A101b; + -- exception + -- when _abort_signal => + -- abort_undefer.all; + -- end; + -- end if; + -- + -- if Timed_Out (DB'Unchecked_Access) then + -- ...continuation for timeout case... + -- end if; + -- end; + + ----------------- + -- Delay_Block -- + ----------------- + + type Delay_Block is limited private; + type Delay_Block_Access is access all Delay_Block; + + function Enqueue_Duration + (T : Duration; + D : Delay_Block_Access) return Boolean; + -- Enqueue the specified relative delay. Returns True if the delay has + -- been enqueued, False if it has already expired. If the delay has been + -- enqueued, abort is deferred. + + procedure Cancel_Async_Delay (D : Delay_Block_Access); + -- Cancel the specified asynchronous delay + + function Timed_Out (D : Delay_Block_Access) return Boolean; + pragma Inline (Timed_Out); + -- Return True if the delay specified in D has timed out + + -- There are child units for delays on Ada.Calendar.Time and + -- Ada.Real_Time.Time, so that an application will not need to link in + -- features that is not using. + +private + + type Delay_Block is record + Self_Id : Task_Id; + -- ID of the calling task + + Level : ATC_Level_Base; + -- Normally Level is the ATC nesting level of the + -- async. select statement to which this delay belongs, but + -- after a call has been dequeued we set it to + -- ATC_Level_Infinity so that the Cancel operation can + -- detect repeated calls, and act idempotently. + + Resume_Time : Duration; + -- The absolute wake up time, represented as Duration + + Timed_Out : Boolean := False; + -- Set to true if the delay has timed out + + Succ, Pred : Delay_Block_Access; + -- A double linked list + end record; + + -- The above "overlaying" of Self_ID and Level to hold other + -- data that has a non-overlapping lifetime is an unabashed + -- hack to save memory. + + procedure Time_Enqueue + (T : Duration; + D : Delay_Block_Access); + pragma Inline (Time_Enqueue); + -- Used by the child units to enqueue delays on the timer queue + -- implemented in the body of this package. + +end System.Tasking.Async_Delays; |