aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/ada/s-taasde.ads
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/ada/s-taasde.ads')
-rw-r--r--gcc-4.9/gcc/ada/s-taasde.ads147
1 files changed, 147 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/s-taasde.ads b/gcc-4.9/gcc/ada/s-taasde.ads
new file mode 100644
index 000000000..dc4165a12
--- /dev/null
+++ b/gcc-4.9/gcc/ada/s-taasde.ads
@@ -0,0 +1,147 @@
+------------------------------------------------------------------------------
+-- --
+-- 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-2013, 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. --
+-- --
+------------------------------------------------------------------------------
+
+-- 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/Ada.Real_Time.Time
+ -- so that an application need not link in features that it 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 asynchronous 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. T denotes a point in time as the duration
+ -- elapsed since the epoch of the Ada real-time clock.
+
+end System.Tasking.Async_Delays;