Subversion Repositories scarts

------------------------------------------------------------------------------

--                                                                          --

--                 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-2005 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 : in 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;