]>
Commit | Line | Data |
---|---|---|
e6e7bf38 | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT RUN-TIME COMPONENTS -- | |
4 | -- -- | |
5 | -- S Y S T E M . A S T _ H A N D L I N G -- | |
6 | -- -- | |
7 | -- B o d y -- | |
e6e7bf38 | 8 | -- -- |
9dfe12ae | 9 | -- Copyright (C) 1996-2003 Free Software Foundation, Inc. -- |
e6e7bf38 | 10 | -- -- |
11 | -- GNAT 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 2, 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. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- As a special exception, if other files instantiate generics from this -- | |
23 | -- unit, or you link this unit with other files to produce an executable, -- | |
24 | -- this unit does not by itself cause the resulting executable to be -- | |
25 | -- covered by the GNU General Public License. This exception does not -- | |
26 | -- however invalidate any other reasons why the executable file might be -- | |
27 | -- covered by the GNU Public License. -- | |
28 | -- -- | |
29 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
e78e8c8e | 30 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
e6e7bf38 | 31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | -- This is the OpenVMS/Alpha version. | |
35 | ||
36 | with System; use System; | |
37 | ||
38 | with System.IO; | |
39 | ||
40 | with System.Machine_Code; | |
9dfe12ae | 41 | with System.Parameters; |
e6e7bf38 | 42 | with System.Storage_Elements; |
43 | ||
44 | with System.Tasking; | |
45 | with System.Tasking.Rendezvous; | |
46 | with System.Tasking.Initialization; | |
47 | with System.Tasking.Utilities; | |
48 | ||
49 | with System.Task_Primitives; | |
50 | with System.Task_Primitives.Operations; | |
51 | with System.Task_Primitives.Operations.DEC; | |
52 | ||
53 | -- with Ada.Finalization; | |
54 | -- removed, because of problem with controlled attribute ??? | |
55 | ||
56 | with Ada.Task_Attributes; | |
57 | with Ada.Task_Identification; | |
58 | ||
59 | with Ada.Exceptions; use Ada.Exceptions; | |
60 | ||
61 | with Ada.Unchecked_Conversion; | |
e6e7bf38 | 62 | |
63 | package body System.AST_Handling is | |
64 | ||
65 | package ATID renames Ada.Task_Identification; | |
66 | ||
9dfe12ae | 67 | package SP renames System.Parameters; |
e6e7bf38 | 68 | package ST renames System.Tasking; |
69 | package STR renames System.Tasking.Rendezvous; | |
70 | package STI renames System.Tasking.Initialization; | |
71 | package STU renames System.Tasking.Utilities; | |
72 | ||
73 | package SSE renames System.Storage_Elements; | |
74 | package STPO renames System.Task_Primitives.Operations; | |
75 | package STPOD renames System.Task_Primitives.Operations.DEC; | |
76 | ||
77 | AST_Lock : aliased System.Task_Primitives.RTS_Lock; | |
78 | -- This is a global lock; it is used to execute in mutual exclusion | |
79 | -- from all other AST tasks. It is only used by Lock_AST and | |
80 | -- Unlock_AST. | |
81 | ||
82 | procedure Lock_AST (Self_ID : ST.Task_ID); | |
83 | -- Locks out other AST tasks. Preceding a section of code by Lock_AST and | |
84 | -- following it by Unlock_AST creates a critical region. | |
85 | ||
86 | procedure Unlock_AST (Self_ID : ST.Task_ID); | |
87 | -- Releases lock previously set by call to Lock_AST. | |
88 | -- All nested locks must be released before other tasks competing for the | |
89 | -- tasking lock are released. | |
90 | ||
9dfe12ae | 91 | -------------- |
e6e7bf38 | 92 | -- Lock_AST -- |
9dfe12ae | 93 | -------------- |
e6e7bf38 | 94 | |
95 | procedure Lock_AST (Self_ID : ST.Task_ID) is | |
96 | begin | |
97 | STI.Defer_Abort_Nestable (Self_ID); | |
9dfe12ae | 98 | STPO.Write_Lock (AST_Lock'Access, Global_Lock => True); |
e6e7bf38 | 99 | end Lock_AST; |
100 | ||
9dfe12ae | 101 | ---------------- |
e6e7bf38 | 102 | -- Unlock_AST -- |
9dfe12ae | 103 | ---------------- |
e6e7bf38 | 104 | |
105 | procedure Unlock_AST (Self_ID : ST.Task_ID) is | |
106 | begin | |
9dfe12ae | 107 | STPO.Unlock (AST_Lock'Access, Global_Lock => True); |
e6e7bf38 | 108 | STI.Undefer_Abort_Nestable (Self_ID); |
109 | end Unlock_AST; | |
110 | ||
111 | --------------------------------- | |
112 | -- AST_Handler Data Structures -- | |
113 | --------------------------------- | |
114 | ||
115 | -- As noted in the private part of the spec of System.Aux_DEC, the | |
116 | -- AST_Handler type is simply a pointer to a procedure that takes | |
117 | -- a single 64bit parameter. The following is a local copy | |
118 | -- of that definition. | |
119 | ||
120 | -- We need our own copy because we need to get our hands on this | |
121 | -- and we cannot see the private part of System.Aux_DEC. We don't | |
122 | -- want to be a child of Aux_Dec because of complications resulting | |
123 | -- from the use of pragma Extend_System. We will use unchecked | |
124 | -- conversions between the two versions of the declarations. | |
125 | ||
126 | type AST_Handler is access procedure (Param : Long_Integer); | |
127 | ||
128 | -- However, this declaration is somewhat misleading, since the values | |
129 | -- referenced by AST_Handler values (all produced in this package by | |
130 | -- calls to Create_AST_Handler) are highly stylized. | |
131 | ||
132 | -- The first point is that in VMS/Alpha, procedure pointers do not in | |
133 | -- fact point to code, but rather to a 48-byte procedure descriptor. | |
134 | -- So a value of type AST_Handler is in fact a pointer to one of these | |
135 | -- 48-byte descriptors. | |
136 | ||
137 | type Descriptor_Type is new SSE.Storage_Array (1 .. 48); | |
138 | for Descriptor_Type'Alignment use Standard'Maximum_Alignment; | |
9dfe12ae | 139 | pragma Warnings (Off, Descriptor_Type); |
140 | -- Suppress harmless warnings about alignment. | |
141 | -- Should explain why this warning is harmless ??? | |
142 | ||
e6e7bf38 | 143 | type Descriptor_Ref is access all Descriptor_Type; |
144 | ||
145 | -- Normally, there is only one such descriptor for a given procedure, but | |
146 | -- it works fine to make a copy of the single allocated descriptor, and | |
147 | -- use the copy itself, and we take advantage of this in the design here. | |
148 | -- The idea is that AST_Handler values will all point to a record with the | |
149 | -- following structure: | |
150 | ||
151 | -- Note: When we say it works fine, there is one delicate point, which | |
152 | -- is that the code for the AST procedure itself requires the original | |
153 | -- descriptor address. We handle this by saving the orignal descriptor | |
154 | -- address in this structure and restoring in Process_AST. | |
155 | ||
156 | type AST_Handler_Data is record | |
157 | Descriptor : Descriptor_Type; | |
158 | Original_Descriptor_Ref : Descriptor_Ref; | |
159 | Taskid : ATID.Task_Id; | |
160 | Entryno : Natural; | |
161 | end record; | |
162 | ||
163 | type AST_Handler_Data_Ref is access all AST_Handler_Data; | |
164 | ||
165 | function To_AST_Handler is new Ada.Unchecked_Conversion | |
166 | (AST_Handler_Data_Ref, System.Aux_DEC.AST_Handler); | |
167 | ||
e6e7bf38 | 168 | -- Each time Create_AST_Handler is called, a new value of this record |
169 | -- type is created, containing a copy of the procedure descriptor for | |
170 | -- the routine used to handle all AST's (Process_AST), and the Task_Id | |
171 | -- and entry number parameters identifying the task entry involved. | |
172 | ||
173 | -- The AST_Handler value returned is a pointer to this record. Since | |
174 | -- the record starts with the procedure descriptor, it can be used | |
175 | -- by the system in the normal way to call the procedure. But now | |
176 | -- when the procedure gets control, it can determine the address of | |
177 | -- the procedure descriptor used to call it (since the ABI specifies | |
178 | -- that this is left sitting in register r27 on entry), and then use | |
179 | -- that address to retrieve the Task_Id and entry number so that it | |
180 | -- knows on which entry to queue the AST request. | |
181 | ||
182 | -- The next issue is where are these records placed. Since we intend | |
183 | -- to pass pointers to these records to asynchronous system service | |
184 | -- routines, they have to be on the heap, which means we have to worry | |
185 | -- about when to allocate them and deallocate them. | |
186 | ||
187 | -- We solve this problem by introducing a task attribute that points to | |
188 | -- a vector, indexed by the entry number, of AST_Handler_Data records | |
189 | -- for a given task. The pointer itself is a controlled object allowing | |
190 | -- us to write a finalization routine that frees the referenced vector. | |
191 | ||
192 | -- An entry in this vector is either initialized (Entryno non-zero) and | |
193 | -- can be used for any subsequent reference to the same entry, or it is | |
194 | -- unused, marked by the Entryno value being zero. | |
195 | ||
196 | type AST_Handler_Vector is array (Natural range <>) of AST_Handler_Data; | |
197 | type AST_Handler_Vector_Ref is access all AST_Handler_Vector; | |
e6e7bf38 | 198 | |
199 | -- type AST_Vector_Ptr is new Ada.Finalization.Controlled with record | |
200 | -- removed due to problem with controlled attribute, consequence is that | |
201 | -- we have a memory leak if a task that has AST attribute entries is | |
202 | -- terminated. ??? | |
203 | ||
204 | type AST_Vector_Ptr is record | |
205 | Vector : AST_Handler_Vector_Ref; | |
206 | end record; | |
207 | ||
e6e7bf38 | 208 | AST_Vector_Init : AST_Vector_Ptr; |
209 | -- Initial value, treated as constant, Vector will be null. | |
210 | ||
211 | package AST_Attribute is new Ada.Task_Attributes | |
212 | (Attribute => AST_Vector_Ptr, | |
213 | Initial_Value => AST_Vector_Init); | |
214 | ||
215 | use AST_Attribute; | |
216 | ||
217 | ----------------------- | |
218 | -- AST Service Queue -- | |
219 | ----------------------- | |
220 | ||
221 | -- The following global data structures are used to queue pending | |
222 | -- AST requests. When an AST is signalled, the AST service routine | |
223 | -- Process_AST is called, and it makes an entry in this structure. | |
224 | ||
225 | type AST_Instance is record | |
226 | Taskid : ATID.Task_Id; | |
227 | Entryno : Natural; | |
228 | Param : Long_Integer; | |
229 | end record; | |
230 | -- The Taskid and Entryno indicate the entry on which this AST is to | |
231 | -- be queued, and Param is the parameter provided from the AST itself. | |
232 | ||
233 | AST_Service_Queue_Size : constant := 256; | |
234 | AST_Service_Queue_Limit : constant := 250; | |
235 | type AST_Service_Queue_Index is mod AST_Service_Queue_Size; | |
236 | -- Index used to refer to entries in the circular buffer which holds | |
237 | -- active AST_Instance values. The upper bound reflects the maximum | |
238 | -- number of AST instances that can be stored in the buffer. Since | |
239 | -- these entries are immediately serviced by the high priority server | |
240 | -- task that does the actual entry queuing, it is very unusual to have | |
241 | -- any significant number of entries simulaneously queued. | |
242 | ||
243 | AST_Service_Queue : array (AST_Service_Queue_Index) of AST_Instance; | |
244 | pragma Volatile_Components (AST_Service_Queue); | |
245 | -- The circular buffer used to store active AST requests. | |
246 | ||
247 | AST_Service_Queue_Put : AST_Service_Queue_Index := 0; | |
248 | AST_Service_Queue_Get : AST_Service_Queue_Index := 0; | |
249 | pragma Atomic (AST_Service_Queue_Put); | |
250 | pragma Atomic (AST_Service_Queue_Get); | |
251 | -- These two variables point to the next slots in the AST_Service_Queue | |
252 | -- to be used for putting a new entry in and taking an entry out. This | |
253 | -- is a circular buffer, so these pointers wrap around. If the two values | |
254 | -- are equal the buffer is currently empty. The pointers are atomic to | |
255 | -- ensure proper synchronization between the single producer (namely the | |
256 | -- Process_AST procedure), and the single consumer (the AST_Service_Task). | |
257 | ||
258 | -------------------------------- | |
259 | -- AST Server Task Structures -- | |
260 | -------------------------------- | |
261 | ||
262 | -- The basic approach is that when an AST comes in, a call is made to | |
263 | -- the Process_AST procedure. It queues the request in the service queue | |
264 | -- and then wakes up an AST server task to perform the actual call to the | |
265 | -- required entry. We use this intermediate server task, since the AST | |
266 | -- procedure itself cannot wait to return, and we need some caller for | |
267 | -- the rendezvous so that we can use the normal rendezvous mechanism. | |
268 | ||
269 | -- It would work to have only one AST server task, but then we would lose | |
270 | -- all overlap in AST processing, and furthermore, we could get priority | |
271 | -- inversion effects resulting in starvation of AST requests. | |
272 | ||
273 | -- We therefore maintain a small pool of AST server tasks. We adjust | |
274 | -- the size of the pool dynamically to reflect traffic, so that we have | |
275 | -- a sufficient number of server tasks to avoid starvation. | |
276 | ||
277 | Max_AST_Servers : constant Natural := 16; | |
278 | -- Maximum number of AST server tasks that can be allocated | |
279 | ||
280 | Num_AST_Servers : Natural := 0; | |
281 | -- Number of AST server tasks currently active | |
282 | ||
283 | Num_Waiting_AST_Servers : Natural := 0; | |
284 | -- This is the number of AST server tasks that are either waiting for | |
285 | -- work, or just about to go to sleep and wait for work. | |
286 | ||
287 | Is_Waiting : array (1 .. Max_AST_Servers) of Boolean := (others => False); | |
288 | -- An array of flags showing which AST server tasks are currently waiting | |
289 | ||
290 | AST_Task_Ids : array (1 .. Max_AST_Servers) of ST.Task_ID; | |
291 | -- Task Id's of allocated AST server tasks | |
292 | ||
293 | task type AST_Server_Task (Num : Natural) is | |
294 | pragma Priority (Priority'Last); | |
295 | end AST_Server_Task; | |
296 | -- Declaration for AST server task. This task has no entries, it is | |
297 | -- controlled by sleep and wakeup calls at the task primitives level. | |
298 | ||
299 | type AST_Server_Task_Ptr is access all AST_Server_Task; | |
300 | -- Type used to allocate server tasks | |
301 | ||
e6e7bf38 | 302 | ----------------------- |
303 | -- Local Subprograms -- | |
304 | ----------------------- | |
305 | ||
306 | procedure Allocate_New_AST_Server; | |
307 | -- Allocate an additional AST server task | |
308 | ||
309 | procedure Process_AST (Param : Long_Integer); | |
310 | -- This is the central routine for processing all AST's, it is referenced | |
311 | -- as the code address of all created AST_Handler values. See detailed | |
312 | -- description in body to understand how it works to have a single such | |
313 | -- procedure for all AST's even though it does not get any indication of | |
314 | -- the entry involved passed as an explicit parameter. The single explicit | |
315 | -- parameter Param is the parameter passed by the system with the AST. | |
316 | ||
317 | ----------------------------- | |
318 | -- Allocate_New_AST_Server -- | |
319 | ----------------------------- | |
320 | ||
321 | procedure Allocate_New_AST_Server is | |
322 | Dummy : AST_Server_Task_Ptr; | |
323 | ||
324 | begin | |
325 | if Num_AST_Servers = Max_AST_Servers then | |
326 | return; | |
327 | ||
328 | else | |
329 | -- Note: it is safe to increment Num_AST_Servers immediately, since | |
330 | -- no one will try to activate this task until it indicates that it | |
331 | -- is sleeping by setting its entry in Is_Waiting to True. | |
332 | ||
333 | Num_AST_Servers := Num_AST_Servers + 1; | |
334 | Dummy := new AST_Server_Task (Num_AST_Servers); | |
335 | end if; | |
336 | end Allocate_New_AST_Server; | |
337 | ||
338 | --------------------- | |
339 | -- AST_Server_Task -- | |
340 | --------------------- | |
341 | ||
342 | task body AST_Server_Task is | |
343 | Taskid : ATID.Task_Id; | |
344 | Entryno : Natural; | |
345 | Param : aliased Long_Integer; | |
346 | Self_Id : constant ST.Task_ID := ST.Self; | |
347 | ||
348 | pragma Volatile (Param); | |
349 | ||
350 | begin | |
351 | -- By making this task independent of master, when the environment | |
352 | -- task is finalizing, the AST_Server_Task will be notified that it | |
353 | -- should terminate. | |
354 | ||
355 | STU.Make_Independent; | |
356 | ||
357 | -- Record our task Id for access by Process_AST | |
358 | ||
359 | AST_Task_Ids (Num) := Self_Id; | |
360 | ||
361 | -- Note: this entire task operates with the main task lock set, except | |
362 | -- when it is sleeping waiting for work, or busy doing a rendezvous | |
363 | -- with an AST server. This lock protects the data structures that | |
364 | -- are shared by multiple instances of the server task. | |
365 | ||
366 | Lock_AST (Self_Id); | |
367 | ||
368 | -- This is the main infinite loop of the task. We go to sleep and | |
369 | -- wait to be woken up by Process_AST when there is some work to do. | |
370 | ||
371 | loop | |
372 | Num_Waiting_AST_Servers := Num_Waiting_AST_Servers + 1; | |
373 | ||
374 | Unlock_AST (Self_Id); | |
375 | ||
376 | STI.Defer_Abort (Self_Id); | |
9dfe12ae | 377 | |
378 | if SP.Single_Lock then | |
379 | STPO.Lock_RTS; | |
380 | end if; | |
381 | ||
e6e7bf38 | 382 | STPO.Write_Lock (Self_Id); |
383 | ||
384 | Is_Waiting (Num) := True; | |
385 | ||
386 | Self_Id.Common.State := ST.AST_Server_Sleep; | |
387 | STPO.Sleep (Self_Id, ST.AST_Server_Sleep); | |
388 | Self_Id.Common.State := ST.Runnable; | |
389 | ||
390 | STPO.Unlock (Self_Id); | |
391 | ||
9dfe12ae | 392 | if SP.Single_Lock then |
393 | STPO.Unlock_RTS; | |
394 | end if; | |
395 | ||
e6e7bf38 | 396 | -- If the process is finalizing, Undefer_Abort will simply end |
397 | -- this task. | |
398 | ||
399 | STI.Undefer_Abort (Self_Id); | |
400 | ||
401 | -- We are awake, there is something to do! | |
402 | ||
403 | Lock_AST (Self_Id); | |
404 | Num_Waiting_AST_Servers := Num_Waiting_AST_Servers - 1; | |
405 | ||
406 | -- Loop here to service outstanding requests. We are always | |
407 | -- locked on entry to this loop. | |
408 | ||
409 | while AST_Service_Queue_Get /= AST_Service_Queue_Put loop | |
410 | Taskid := AST_Service_Queue (AST_Service_Queue_Get).Taskid; | |
411 | Entryno := AST_Service_Queue (AST_Service_Queue_Get).Entryno; | |
412 | Param := AST_Service_Queue (AST_Service_Queue_Get).Param; | |
413 | ||
414 | AST_Service_Queue_Get := AST_Service_Queue_Get + 1; | |
415 | ||
416 | -- This is a manual expansion of the normal call simple code | |
417 | ||
418 | declare | |
419 | type AA is access all Long_Integer; | |
420 | P : AA := Param'Unrestricted_Access; | |
421 | ||
422 | function To_ST_Task_Id is new Ada.Unchecked_Conversion | |
423 | (ATID.Task_Id, ST.Task_ID); | |
424 | ||
425 | begin | |
426 | Unlock_AST (Self_Id); | |
427 | STR.Call_Simple | |
428 | (Acceptor => To_ST_Task_Id (Taskid), | |
429 | E => ST.Task_Entry_Index (Entryno), | |
430 | Uninterpreted_Data => P'Address); | |
9dfe12ae | 431 | |
e6e7bf38 | 432 | exception |
433 | when E : others => | |
434 | System.IO.Put_Line ("%Debugging event"); | |
435 | System.IO.Put_Line (Exception_Name (E) & | |
436 | " raised when trying to deliver an AST."); | |
9dfe12ae | 437 | |
e6e7bf38 | 438 | if Exception_Message (E)'Length /= 0 then |
439 | System.IO.Put_Line (Exception_Message (E)); | |
440 | end if; | |
9dfe12ae | 441 | |
e6e7bf38 | 442 | System.IO.Put_Line ("Task type is " & "Receiver_Type"); |
443 | System.IO.Put_Line ("Task id is " & ATID.Image (Taskid)); | |
444 | end; | |
9dfe12ae | 445 | |
e6e7bf38 | 446 | Lock_AST (Self_Id); |
447 | end loop; | |
448 | end loop; | |
e6e7bf38 | 449 | end AST_Server_Task; |
450 | ||
451 | ------------------------ | |
452 | -- Create_AST_Handler -- | |
453 | ------------------------ | |
454 | ||
455 | function Create_AST_Handler | |
456 | (Taskid : ATID.Task_Id; | |
457 | Entryno : Natural) | |
458 | return System.Aux_DEC.AST_Handler | |
459 | is | |
460 | Attr_Ref : Attribute_Handle; | |
461 | ||
462 | Process_AST_Ptr : constant AST_Handler := Process_AST'Access; | |
463 | -- Reference to standard procedure descriptor for Process_AST | |
464 | ||
465 | function To_Descriptor_Ref is new Ada.Unchecked_Conversion | |
466 | (AST_Handler, Descriptor_Ref); | |
467 | ||
468 | Original_Descriptor_Ref : Descriptor_Ref := | |
469 | To_Descriptor_Ref (Process_AST_Ptr); | |
470 | ||
471 | begin | |
472 | if ATID.Is_Terminated (Taskid) then | |
473 | raise Program_Error; | |
474 | end if; | |
475 | ||
476 | Attr_Ref := Reference (Taskid); | |
477 | ||
478 | -- Allocate another server if supply is getting low | |
479 | ||
480 | if Num_Waiting_AST_Servers < 2 then | |
481 | Allocate_New_AST_Server; | |
482 | end if; | |
483 | ||
484 | -- No point in creating more if we have zillions waiting to | |
485 | -- be serviced. | |
486 | ||
487 | while AST_Service_Queue_Put - AST_Service_Queue_Get | |
488 | > AST_Service_Queue_Limit | |
489 | loop | |
490 | delay 0.01; | |
491 | end loop; | |
492 | ||
493 | -- If no AST vector allocated, or the one we have is too short, then | |
494 | -- allocate one of right size and initialize all entries except the | |
495 | -- one we will use to unused. Note that the assignment automatically | |
496 | -- frees the old allocated table if there is one. | |
497 | ||
498 | if Attr_Ref.Vector = null | |
499 | or else Attr_Ref.Vector'Length < Entryno | |
500 | then | |
501 | Attr_Ref.Vector := new AST_Handler_Vector (1 .. Entryno); | |
502 | ||
503 | for E in 1 .. Entryno loop | |
504 | Attr_Ref.Vector (E).Descriptor := | |
505 | Original_Descriptor_Ref.all; | |
506 | Attr_Ref.Vector (E).Original_Descriptor_Ref := | |
507 | Original_Descriptor_Ref; | |
508 | Attr_Ref.Vector (E).Taskid := Taskid; | |
509 | Attr_Ref.Vector (E).Entryno := E; | |
510 | end loop; | |
511 | end if; | |
512 | ||
513 | return To_AST_Handler (Attr_Ref.Vector (Entryno)'Unrestricted_Access); | |
514 | end Create_AST_Handler; | |
515 | ||
516 | ---------------------------- | |
517 | -- Expand_AST_Packet_Pool -- | |
518 | ---------------------------- | |
519 | ||
520 | procedure Expand_AST_Packet_Pool | |
521 | (Requested_Packets : in Natural; | |
522 | Actual_Number : out Natural; | |
523 | Total_Number : out Natural) | |
524 | is | |
9dfe12ae | 525 | pragma Unreferenced (Requested_Packets); |
e6e7bf38 | 526 | begin |
527 | -- The AST implementation of GNAT does not permit dynamic expansion | |
528 | -- of the pool, so we simply add no entries and return the total. If | |
529 | -- it is necessary to expand the allocation, then this package body | |
530 | -- must be recompiled with a larger value for AST_Service_Queue_Size. | |
531 | ||
532 | Actual_Number := 0; | |
533 | Total_Number := AST_Service_Queue_Size; | |
534 | end Expand_AST_Packet_Pool; | |
535 | ||
e6e7bf38 | 536 | ----------------- |
537 | -- Process_AST -- | |
538 | ----------------- | |
539 | ||
540 | procedure Process_AST (Param : Long_Integer) is | |
541 | ||
542 | Handler_Data_Ptr : AST_Handler_Data_Ref; | |
543 | -- This variable is set to the address of the descriptor through | |
544 | -- which Process_AST is called. Since the descriptor is part of | |
545 | -- an AST_Handler value, this is also the address of this value, | |
546 | -- from which we can obtain the task and entry number information. | |
547 | ||
548 | function To_Address is new Ada.Unchecked_Conversion | |
549 | (ST.Task_ID, System.Address); | |
550 | ||
551 | begin | |
552 | System.Machine_Code.Asm | |
553 | (Template => "addl $27,0,%0", | |
554 | Outputs => AST_Handler_Data_Ref'Asm_Output ("=r", Handler_Data_Ptr), | |
555 | Volatile => True); | |
556 | ||
557 | System.Machine_Code.Asm | |
558 | (Template => "ldl $27,%0", | |
559 | Inputs => Descriptor_Ref'Asm_Input | |
560 | ("m", Handler_Data_Ptr.Original_Descriptor_Ref), | |
561 | Volatile => True); | |
562 | ||
563 | AST_Service_Queue (AST_Service_Queue_Put) := AST_Instance' | |
564 | (Taskid => Handler_Data_Ptr.Taskid, | |
565 | Entryno => Handler_Data_Ptr.Entryno, | |
566 | Param => Param); | |
567 | ||
9dfe12ae | 568 | -- OpenVMS Programming Concepts manual, chapter 8.2.3: |
569 | -- "Implicit synchronization can be achieved for data that is shared | |
570 | -- for write by using only AST routines to write the data, since only | |
571 | -- one AST can be running at any one time." | |
572 | ||
573 | -- This subprogram runs at AST level so is guaranteed to be | |
574 | -- called sequentially at a given access level. | |
e6e7bf38 | 575 | |
576 | AST_Service_Queue_Put := AST_Service_Queue_Put + 1; | |
577 | ||
578 | -- Need to wake up processing task. If there is no waiting server | |
579 | -- then we have temporarily run out, but things should still be | |
580 | -- OK, since one of the active ones will eventually pick up the | |
581 | -- service request queued in the AST_Service_Queue. | |
582 | ||
583 | for J in 1 .. Num_AST_Servers loop | |
584 | if Is_Waiting (J) then | |
585 | Is_Waiting (J) := False; | |
586 | ||
587 | -- Sleeps are handled by ASTs on VMS, so don't call Wakeup. | |
e6e7bf38 | 588 | |
9dfe12ae | 589 | STPOD.Interrupt_AST_Handler (To_Address (AST_Task_Ids (J))); |
e6e7bf38 | 590 | exit; |
591 | end if; | |
592 | end loop; | |
593 | end Process_AST; | |
594 | ||
595 | begin | |
596 | STPO.Initialize_Lock (AST_Lock'Access, STPO.Global_Task_Level); | |
597 | end System.AST_Handling; |