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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [s-tpobop.ads] - Blame information for rev 297

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

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
4
--                                                                          --
5
--               SYSTEM.TASKING.PROTECTED_OBJECTS.OPERATIONS                --
6
--                                                                          --
7
--                                  S p e c                                 --
8
--                                                                          --
9
--          Copyright (C) 1992-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 all the extended primitives related to protected
33
--  objects with entries.
34
 
35
--  The handling of protected objects with no entries is done in
36
--  System.Tasking.Protected_Objects, the simple routines for protected
37
--  objects with entries in System.Tasking.Protected_Objects.Entries. The
38
--  split between Entries and Operations is needed to break circular
39
--  dependencies inside the run time.
40
 
41
--  Note: the compiler generates direct calls to this interface, via Rtsfind.
42
--  Any changes to this interface may require corresponding compiler changes.
43
 
44
with Ada.Exceptions;
45
 
46
with System.Tasking.Protected_Objects.Entries;
47
 
48
package System.Tasking.Protected_Objects.Operations is
49
   pragma Elaborate_Body;
50
 
51
   type Communication_Block is private;
52
   --  Objects of this type are passed between GNARL calls to allow RTS
53
   --  information to be preserved.
54
 
55
   procedure Protected_Entry_Call
56
     (Object             : Entries.Protection_Entries_Access;
57
      E                  : Protected_Entry_Index;
58
      Uninterpreted_Data : System.Address;
59
      Mode               : Call_Modes;
60
      Block              : out Communication_Block);
61
   --  Make a protected entry call to the specified object.
62
   --  Pend a protected entry call on the protected object represented
63
   --  by Object. A pended call is not queued; it may be executed immediately
64
   --  or queued, depending on the state of the entry barrier.
65
   --
66
   --    E
67
   --      The index representing the entry to be called.
68
   --
69
   --    Uninterpreted_Data
70
   --      This will be returned by Next_Entry_Call when this call is serviced.
71
   --      It can be used by the compiler to pass information between the
72
   --      caller and the server, in particular entry parameters.
73
   --
74
   --    Mode
75
   --      The kind of call to be pended
76
   --
77
   --    Block
78
   --      Information passed between runtime calls by the compiler
79
 
80
   procedure Timed_Protected_Entry_Call
81
     (Object                : Entries.Protection_Entries_Access;
82
      E                     : Protected_Entry_Index;
83
      Uninterpreted_Data    : System.Address;
84
      Timeout               : Duration;
85
      Mode                  : Delay_Modes;
86
      Entry_Call_Successful : out Boolean);
87
   --  Same as the Protected_Entry_Call but with time-out specified.
88
   --  This routines is used when we do not use ATC mechanism to implement
89
   --  timed entry calls.
90
 
91
   procedure Service_Entries (Object : Entries.Protection_Entries_Access);
92
   pragma Inline (Service_Entries);
93
 
94
   procedure PO_Service_Entries
95
     (Self_ID       : Task_Id;
96
      Object        : Entries.Protection_Entries_Access;
97
      Unlock_Object : Boolean := True);
98
   --  Service all entry queues of the specified object, executing the
99
   --  corresponding bodies of any queued entry calls that are waiting
100
   --  on True barriers. This is used when the state of a protected
101
   --  object may have changed, in particular after the execution of
102
   --  the statement sequence of a protected procedure.
103
   --
104
   --  Note that servicing an entry may change the value of one or more
105
   --  barriers, so this routine keeps checking barriers until all of
106
   --  them are closed.
107
   --
108
   --  This must be called with abort deferred and with the corresponding
109
   --  object locked.
110
   --
111
   --  If Unlock_Object is set True, then Object is unlocked on return,
112
   --  otherwise Object remains locked and the caller is responsible for
113
   --  the required unlock.
114
 
115
   procedure Complete_Entry_Body (Object : Entries.Protection_Entries_Access);
116
   --  Called from within an entry body procedure, indicates that the
117
   --  corresponding entry call has been serviced.
118
 
119
   procedure Exceptional_Complete_Entry_Body
120
     (Object : Entries.Protection_Entries_Access;
121
      Ex     : Ada.Exceptions.Exception_Id);
122
   --  Perform all of the functions of Complete_Entry_Body. In addition,
123
   --  report in Ex the exception whose propagation terminated the entry
124
   --  body to the runtime system.
125
 
126
   procedure Cancel_Protected_Entry_Call (Block : in out Communication_Block);
127
   --  Attempt to cancel the most recent protected entry call. If the call is
128
   --  not queued abortably, wait until it is or until it has completed.
129
   --  If the call is actually cancelled, the called object will be
130
   --  locked on return from this call. Get_Cancelled (Block) can be
131
   --  used to determine if the cancellation took place; there
132
   --  may be entries needing service in this case.
133
   --
134
   --  Block passes information between this and other runtime calls.
135
 
136
   function Enqueued (Block : Communication_Block) return Boolean;
137
   --  Returns True if the Protected_Entry_Call which returned the
138
   --  specified Block object was queued; False otherwise.
139
 
140
   function Cancelled (Block : Communication_Block) return Boolean;
141
   --  Returns True if the Protected_Entry_Call which returned the
142
   --  specified Block object was cancelled, False otherwise.
143
 
144
   procedure Requeue_Protected_Entry
145
     (Object     : Entries.Protection_Entries_Access;
146
      New_Object : Entries.Protection_Entries_Access;
147
      E          : Protected_Entry_Index;
148
      With_Abort : Boolean);
149
   --  If Object = New_Object, queue the protected entry call on Object
150
   --   currently being serviced on the queue corresponding to the entry
151
   --   represented by E.
152
   --
153
   --  If Object /= New_Object, transfer the call to New_Object.E,
154
   --   executing or queuing it as appropriate.
155
   --
156
   --  With_Abort---True if the call is to be queued abortably, false
157
   --   otherwise.
158
 
159
   procedure Requeue_Task_To_Protected_Entry
160
     (New_Object : Entries.Protection_Entries_Access;
161
      E          : Protected_Entry_Index;
162
      With_Abort : Boolean);
163
   --  Transfer task entry call currently being serviced to entry E
164
   --   on New_Object.
165
   --
166
   --  With_Abort---True if the call is to be queued abortably, false
167
   --   otherwise.
168
 
169
   function Protected_Count
170
     (Object : Entries.Protection_Entries'Class;
171
      E      : Protected_Entry_Index)
172
      return   Natural;
173
   --  Return the number of entry calls to E on Object
174
 
175
   function Protected_Entry_Caller
176
     (Object : Entries.Protection_Entries'Class) return Task_Id;
177
   --  Return value of E'Caller, where E is the protected entry currently
178
   --  being handled. This will only work if called from within an entry
179
   --  body, as required by the LRM (C.7.1(14)).
180
 
181
   --  For internal use only
182
 
183
   procedure PO_Do_Or_Queue
184
     (Self_ID    : Task_Id;
185
      Object     : Entries.Protection_Entries_Access;
186
      Entry_Call : Entry_Call_Link);
187
   --  This procedure either executes or queues an entry call, depending
188
   --  on the status of the corresponding barrier. It assumes that abort
189
   --  is deferred and that the specified object is locked.
190
 
191
private
192
   type Communication_Block is record
193
      Self      : Task_Id;
194
      Enqueued  : Boolean := True;
195
      Cancelled : Boolean := False;
196
   end record;
197
   pragma Volatile (Communication_Block);
198
 
199
   --  When a program contains limited interfaces, the compiler generates the
200
   --  predefined primitives associated with dispatching selects. One of the
201
   --  parameters of these routines is of type Communication_Block. Even if
202
   --  the program lacks implementing concurrent types, the tasking runtime is
203
   --  dragged in unconditionally because of Communication_Block. To avoid this
204
   --  case, the compiler uses type Dummy_Communication_Block which defined in
205
   --  System.Soft_Links. If the structure of Communication_Block is changed,
206
   --  the corresponding dummy type must be changed as well.
207
 
208
   --  The Communication_Block seems to be a relic. At the moment, the
209
   --  compiler seems to be generating unnecessary conditional code based on
210
   --  this block. See the code generated for async. select with task entry
211
   --  call for another way of solving this ???
212
 
213
end System.Tasking.Protected_Objects.Operations;

powered by: WebSVN 2.1.0

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