OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-taasde.ads] - Blame information for rev 720

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
4
--                                                                          --
5
--           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S          --
6
--                                                                          --
7
--                                  S p e c                                 --
8
--                                                                          --
9
--          Copyright (C) 1998-2009, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNARL is free software; you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNARL was developed by the GNARL team at Florida State University.       --
28
-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
--  This package contains the procedures to implements timeouts (delays) for
33
--  asynchronous select statements.
34
 
35
--  Note: the compiler generates direct calls to this interface, via Rtsfind.
36
--  Any changes to this interface may require corresponding compiler changes.
37
 
38
package System.Tasking.Async_Delays is
39
 
40
   --  Suppose the following source code is given:
41
 
42
   --  select delay When;
43
   --     ...continuation for timeout case...
44
   --  then abort
45
   --     ...abortable part...
46
   --  end select;
47
 
48
   --  The compiler should expand this to the following:
49
 
50
   --  declare
51
   --     DB : aliased Delay_Block;
52
   --  begin
53
   --     if System.Tasking.Async_Delays.Enqueue_Duration
54
   --       (When, DB'Unchecked_Access)
55
   --     then
56
   --        begin
57
   --           A101b : declare
58
   --              procedure _clean is
59
   --              begin
60
   --                 System.Tasking.Async_Delays.Cancel_Async_Delay
61
   --                   (DB'Unchecked_Access);
62
   --                 return;
63
   --              end _clean;
64
   --           begin
65
   --              abort_undefer.all;
66
   --              ...abortable part...
67
   --           exception
68
   --              when all others =>
69
   --                 declare
70
   --                    E105b : exception_occurrence;
71
   --                 begin
72
   --                    save_occurrence (E105b, get_current_excep.all.all);
73
   --                    _clean;
74
   --                    reraise_occurrence_no_defer (E105b);
75
   --                 end;
76
   --           at end
77
   --              _clean;
78
   --           end A101b;
79
   --        exception
80
   --           when _abort_signal =>
81
   --              abort_undefer.all;
82
   --        end;
83
   --     end if;
84
   --
85
   --     if Timed_Out (DB'Unchecked_Access) then
86
   --        ...continuation for timeout case...
87
   --     end if;
88
   --  end;
89
 
90
   -----------------
91
   -- Delay_Block --
92
   -----------------
93
 
94
   type Delay_Block is limited private;
95
   type Delay_Block_Access is access all Delay_Block;
96
 
97
   function Enqueue_Duration
98
     (T : Duration;
99
      D : Delay_Block_Access) return Boolean;
100
   --  Enqueue the specified relative delay. Returns True if the delay has
101
   --  been enqueued, False if it has already expired. If the delay has been
102
   --  enqueued, abort is deferred.
103
 
104
   procedure Cancel_Async_Delay (D : Delay_Block_Access);
105
   --  Cancel the specified asynchronous delay
106
 
107
   function Timed_Out (D : Delay_Block_Access) return Boolean;
108
   pragma Inline (Timed_Out);
109
   --  Return True if the delay specified in D has timed out
110
 
111
   --  There are child units for delays on Ada.Calendar.Time and
112
   --  Ada.Real_Time.Time, so that an application will not need to link in
113
   --  features that is not using.
114
 
115
private
116
 
117
   type Delay_Block is record
118
      Self_Id : Task_Id;
119
      --  ID of the calling task
120
 
121
      Level : ATC_Level_Base;
122
      --  Normally Level is the ATC nesting level of the
123
      --  async. select statement to which this delay belongs, but
124
      --  after a call has been dequeued we set it to
125
      --  ATC_Level_Infinity so that the Cancel operation can
126
      --  detect repeated calls, and act idempotently.
127
 
128
      Resume_Time : Duration;
129
      --  The absolute wake up time, represented as Duration
130
 
131
      Timed_Out : Boolean := False;
132
      --  Set to true if the delay has timed out
133
 
134
      Succ, Pred : Delay_Block_Access;
135
      --  A double linked list
136
   end record;
137
 
138
   --  The above "overlaying" of Self_ID and Level to hold other
139
   --  data that has a non-overlapping lifetime is an unabashed
140
   --  hack to save memory.
141
 
142
   procedure Time_Enqueue
143
     (T : Duration;
144
      D : Delay_Block_Access);
145
   pragma Inline (Time_Enqueue);
146
   --  Used by the child units to enqueue delays on the timer queue
147
   --  implemented in the body of this package.
148
 
149
end System.Tasking.Async_Delays;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.