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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-asthan-vms-alpha.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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                                  --
8
--                                                                          --
9
--          Copyright (C) 1996-2010, Free Software Foundation, Inc.         --
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 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
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
--  This is the OpenVMS/Alpha version
33
 
34
with System; use System;
35
 
36
with System.IO;
37
 
38
with System.Machine_Code;
39
with System.Parameters;
40
with System.Storage_Elements;
41
 
42
with System.Tasking;
43
with System.Tasking.Rendezvous;
44
with System.Tasking.Initialization;
45
with System.Tasking.Utilities;
46
 
47
with System.Task_Primitives;
48
with System.Task_Primitives.Operations;
49
with System.Task_Primitives.Operations.DEC;
50
 
51
with Ada.Finalization;
52
with Ada.Task_Attributes;
53
 
54
with Ada.Exceptions; use Ada.Exceptions;
55
 
56
with Ada.Unchecked_Conversion;
57
with Ada.Unchecked_Deallocation;
58
 
59
package body System.AST_Handling is
60
 
61
   package ATID renames Ada.Task_Identification;
62
 
63
   package SP   renames System.Parameters;
64
   package ST   renames System.Tasking;
65
   package STR  renames System.Tasking.Rendezvous;
66
   package STI  renames System.Tasking.Initialization;
67
   package STU  renames System.Tasking.Utilities;
68
 
69
   package SSE  renames System.Storage_Elements;
70
   package STPO renames System.Task_Primitives.Operations;
71
   package STPOD renames System.Task_Primitives.Operations.DEC;
72
 
73
   AST_Lock : aliased System.Task_Primitives.RTS_Lock;
74
   --  This is a global lock; it is used to execute in mutual exclusion
75
   --  from all other AST tasks.  It is only used by Lock_AST and
76
   --  Unlock_AST.
77
 
78
   procedure Lock_AST (Self_ID : ST.Task_Id);
79
   --  Locks out other AST tasks. Preceding a section of code by Lock_AST and
80
   --  following it by Unlock_AST creates a critical region.
81
 
82
   procedure Unlock_AST (Self_ID : ST.Task_Id);
83
   --  Releases lock previously set by call to Lock_AST.
84
   --  All nested locks must be released before other tasks competing for the
85
   --  tasking lock are released.
86
 
87
   --------------
88
   -- Lock_AST --
89
   --------------
90
 
91
   procedure Lock_AST (Self_ID : ST.Task_Id) is
92
   begin
93
      STI.Defer_Abort_Nestable (Self_ID);
94
      STPO.Write_Lock (AST_Lock'Access, Global_Lock => True);
95
   end Lock_AST;
96
 
97
   ----------------
98
   -- Unlock_AST --
99
   ----------------
100
 
101
   procedure Unlock_AST (Self_ID : ST.Task_Id) is
102
   begin
103
      STPO.Unlock (AST_Lock'Access, Global_Lock => True);
104
      STI.Undefer_Abort_Nestable (Self_ID);
105
   end Unlock_AST;
106
 
107
   ---------------------------------
108
   -- AST_Handler Data Structures --
109
   ---------------------------------
110
 
111
   --  As noted in the private part of the spec of System.Aux_DEC, the
112
   --  AST_Handler type is simply a pointer to a procedure that takes
113
   --  a single 64bit parameter. The following is a local copy
114
   --  of that definition.
115
 
116
   --  We need our own copy because we need to get our hands on this
117
   --  and we cannot see the private part of System.Aux_DEC. We don't
118
   --  want to be a child of Aux_Dec because of complications resulting
119
   --  from the use of pragma Extend_System. We will use unchecked
120
   --  conversions between the two versions of the declarations.
121
 
122
   type AST_Handler is access procedure (Param : Long_Integer);
123
 
124
   --  However, this declaration is somewhat misleading, since the values
125
   --  referenced by AST_Handler values (all produced in this package by
126
   --  calls to Create_AST_Handler) are highly stylized.
127
 
128
   --  The first point is that in VMS/Alpha, procedure pointers do not in
129
   --  fact point to code, but rather to a 48-byte procedure descriptor.
130
   --  So a value of type AST_Handler is in fact a pointer to one of these
131
   --  48-byte descriptors.
132
 
133
   type Descriptor_Type is new SSE.Storage_Array (1 .. 48);
134
   for  Descriptor_Type'Alignment use Standard'Maximum_Alignment;
135
 
136
   type Descriptor_Ref is access all Descriptor_Type;
137
 
138
   --  Normally, there is only one such descriptor for a given procedure, but
139
   --  it works fine to make a copy of the single allocated descriptor, and
140
   --  use the copy itself, and we take advantage of this in the design here.
141
   --  The idea is that AST_Handler values will all point to a record with the
142
   --  following structure:
143
 
144
   --  Note: When we say it works fine, there is one delicate point, which
145
   --  is that the code for the AST procedure itself requires the original
146
   --  descriptor address.  We handle this by saving the original descriptor
147
   --  address in this structure and restoring in Process_AST.
148
 
149
   type AST_Handler_Data is record
150
      Descriptor              : Descriptor_Type;
151
      Original_Descriptor_Ref : Descriptor_Ref;
152
      Taskid                  : ATID.Task_Id;
153
      Entryno                 : Natural;
154
   end record;
155
 
156
   type AST_Handler_Data_Ref is access all AST_Handler_Data;
157
 
158
   function To_AST_Handler is new Ada.Unchecked_Conversion
159
     (AST_Handler_Data_Ref, System.Aux_DEC.AST_Handler);
160
 
161
   --  Each time Create_AST_Handler is called, a new value of this record
162
   --  type is created, containing a copy of the procedure descriptor for
163
   --  the routine used to handle all AST's (Process_AST), and the Task_Id
164
   --  and entry number parameters identifying the task entry involved.
165
 
166
   --  The AST_Handler value returned is a pointer to this record. Since
167
   --  the record starts with the procedure descriptor, it can be used
168
   --  by the system in the normal way to call the procedure. But now
169
   --  when the procedure gets control, it can determine the address of
170
   --  the procedure descriptor used to call it (since the ABI specifies
171
   --  that this is left sitting in register r27 on entry), and then use
172
   --  that address to retrieve the Task_Id and entry number so that it
173
   --  knows on which entry to queue the AST request.
174
 
175
   --  The next issue is where are these records placed. Since we intend
176
   --  to pass pointers to these records to asynchronous system service
177
   --  routines, they have to be on the heap, which means we have to worry
178
   --  about when to allocate them and deallocate them.
179
 
180
   --  We solve this problem by introducing a task attribute that points to
181
   --  a vector, indexed by the entry number, of AST_Handler_Data records
182
   --  for a given task. The pointer itself is a controlled object allowing
183
   --  us to write a finalization routine that frees the referenced vector.
184
 
185
   --  An entry in this vector is either initialized (Entryno non-zero) and
186
   --  can be used for any subsequent reference to the same entry, or it is
187
   --  unused, marked by the Entryno value being zero.
188
 
189
   type AST_Handler_Vector is array (Natural range <>) of AST_Handler_Data;
190
   type AST_Handler_Vector_Ref is access all AST_Handler_Vector;
191
 
192
   type AST_Vector_Ptr is new Ada.Finalization.Controlled with record
193
      Vector : AST_Handler_Vector_Ref;
194
   end record;
195
 
196
   procedure Finalize (Obj : in out AST_Vector_Ptr);
197
   --  Override Finalize so that the AST Vector gets freed.
198
 
199
   procedure Finalize (Obj : in out AST_Vector_Ptr) is
200
      procedure Free is new
201
       Ada.Unchecked_Deallocation (AST_Handler_Vector, AST_Handler_Vector_Ref);
202
   begin
203
      if Obj.Vector /= null then
204
         Free (Obj.Vector);
205
      end if;
206
   end Finalize;
207
 
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 simultaneously 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
 
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
      pragma Unreferenced (Dummy);
324
 
325
   begin
326
      if Num_AST_Servers = Max_AST_Servers then
327
         return;
328
 
329
      else
330
         --  Note: it is safe to increment Num_AST_Servers immediately, since
331
         --  no one will try to activate this task until it indicates that it
332
         --  is sleeping by setting its entry in Is_Waiting to True.
333
 
334
         Num_AST_Servers := Num_AST_Servers + 1;
335
         Dummy := new AST_Server_Task (Num_AST_Servers);
336
      end if;
337
   end Allocate_New_AST_Server;
338
 
339
   ---------------------
340
   -- AST_Server_Task --
341
   ---------------------
342
 
343
   task body AST_Server_Task is
344
      Taskid  : ATID.Task_Id;
345
      Entryno : Natural;
346
      Param   : aliased Long_Integer;
347
      Self_Id : constant ST.Task_Id := ST.Self;
348
 
349
      pragma Volatile (Param);
350
 
351
   begin
352
      --  By making this task independent of master, when the environment
353
      --  task is finalizing, the AST_Server_Task will be notified that it
354
      --  should terminate.
355
 
356
      STU.Make_Independent;
357
 
358
      --  Record our task Id for access by Process_AST
359
 
360
      AST_Task_Ids (Num) := Self_Id;
361
 
362
      --  Note: this entire task operates with the main task lock set, except
363
      --  when it is sleeping waiting for work, or busy doing a rendezvous
364
      --  with an AST server. This lock protects the data structures that
365
      --  are shared by multiple instances of the server task.
366
 
367
      Lock_AST (Self_Id);
368
 
369
      --  This is the main infinite loop of the task. We go to sleep and
370
      --  wait to be woken up by Process_AST when there is some work to do.
371
 
372
      loop
373
         Num_Waiting_AST_Servers := Num_Waiting_AST_Servers + 1;
374
 
375
         Unlock_AST (Self_Id);
376
 
377
         STI.Defer_Abort (Self_Id);
378
 
379
         if SP.Single_Lock then
380
            STPO.Lock_RTS;
381
         end if;
382
 
383
         STPO.Write_Lock (Self_Id);
384
 
385
         Is_Waiting (Num) := True;
386
 
387
         Self_Id.Common.State := ST.AST_Server_Sleep;
388
         STPO.Sleep (Self_Id, ST.AST_Server_Sleep);
389
         Self_Id.Common.State := ST.Runnable;
390
 
391
         STPO.Unlock (Self_Id);
392
 
393
         if SP.Single_Lock then
394
            STPO.Unlock_RTS;
395
         end if;
396
 
397
         --  If the process is finalizing, Undefer_Abort will simply end
398
         --  this task.
399
 
400
         STI.Undefer_Abort (Self_Id);
401
 
402
         --  We are awake, there is something to do!
403
 
404
         Lock_AST (Self_Id);
405
         Num_Waiting_AST_Servers := Num_Waiting_AST_Servers - 1;
406
 
407
         --  Loop here to service outstanding requests. We are always
408
         --  locked on entry to this loop.
409
 
410
         while AST_Service_Queue_Get /= AST_Service_Queue_Put loop
411
            Taskid  := AST_Service_Queue (AST_Service_Queue_Get).Taskid;
412
            Entryno := AST_Service_Queue (AST_Service_Queue_Get).Entryno;
413
            Param   := AST_Service_Queue (AST_Service_Queue_Get).Param;
414
 
415
            AST_Service_Queue_Get := AST_Service_Queue_Get + 1;
416
 
417
            --  This is a manual expansion of the normal call simple code
418
 
419
            declare
420
               type AA is access all Long_Integer;
421
               P : AA := Param'Unrestricted_Access;
422
 
423
               function To_ST_Task_Id is new Ada.Unchecked_Conversion
424
                 (ATID.Task_Id, ST.Task_Id);
425
 
426
            begin
427
               Unlock_AST (Self_Id);
428
               STR.Call_Simple
429
                 (Acceptor           => To_ST_Task_Id (Taskid),
430
                  E                  => ST.Task_Entry_Index (Entryno),
431
                  Uninterpreted_Data => P'Address);
432
 
433
            exception
434
               when E : others =>
435
                  System.IO.Put_Line ("%Debugging event");
436
                  System.IO.Put_Line (Exception_Name (E) &
437
                    " raised when trying to deliver an AST.");
438
 
439
                  if Exception_Message (E)'Length /= 0 then
440
                     System.IO.Put_Line (Exception_Message (E));
441
                  end if;
442
 
443
                  System.IO.Put_Line ("Task type is " & "Receiver_Type");
444
                  System.IO.Put_Line ("Task id is " & ATID.Image (Taskid));
445
            end;
446
 
447
            Lock_AST (Self_Id);
448
         end loop;
449
      end loop;
450
   end AST_Server_Task;
451
 
452
   ------------------------
453
   -- Create_AST_Handler --
454
   ------------------------
455
 
456
   function Create_AST_Handler
457
     (Taskid  : ATID.Task_Id;
458
      Entryno : Natural) 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
      pragma Warnings (Off, "*alignment*");
466
      --  Suppress harmless warnings about alignment.
467
      --  Should explain why this warning is harmless ???
468
 
469
      function To_Descriptor_Ref is new Ada.Unchecked_Conversion
470
        (AST_Handler, Descriptor_Ref);
471
 
472
      Original_Descriptor_Ref : constant Descriptor_Ref :=
473
                                  To_Descriptor_Ref (Process_AST_Ptr);
474
 
475
      pragma Warnings (On, "*alignment*");
476
 
477
   begin
478
      if ATID.Is_Terminated (Taskid) then
479
         raise Program_Error;
480
      end if;
481
 
482
      Attr_Ref := Reference (Taskid);
483
 
484
      --  Allocate another server if supply is getting low
485
 
486
      if Num_Waiting_AST_Servers < 2 then
487
         Allocate_New_AST_Server;
488
      end if;
489
 
490
      --  No point in creating more if we have zillions waiting to
491
      --  be serviced.
492
 
493
      while AST_Service_Queue_Put - AST_Service_Queue_Get
494
         > AST_Service_Queue_Limit
495
      loop
496
         delay 0.01;
497
      end loop;
498
 
499
      --  If no AST vector allocated, or the one we have is too short, then
500
      --  allocate one of right size and initialize all entries except the
501
      --  one we will use to unused. Note that the assignment automatically
502
      --  frees the old allocated table if there is one.
503
 
504
      if Attr_Ref.Vector = null
505
        or else Attr_Ref.Vector'Length < Entryno
506
      then
507
         Attr_Ref.Vector := new AST_Handler_Vector (1 .. Entryno);
508
 
509
         for E in 1 .. Entryno loop
510
            Attr_Ref.Vector (E).Descriptor :=
511
              Original_Descriptor_Ref.all;
512
            Attr_Ref.Vector (E).Original_Descriptor_Ref :=
513
              Original_Descriptor_Ref;
514
            Attr_Ref.Vector (E).Taskid  := Taskid;
515
            Attr_Ref.Vector (E).Entryno := E;
516
         end loop;
517
      end if;
518
 
519
      return To_AST_Handler (Attr_Ref.Vector (Entryno)'Unrestricted_Access);
520
   end Create_AST_Handler;
521
 
522
   ----------------------------
523
   -- Expand_AST_Packet_Pool --
524
   ----------------------------
525
 
526
   procedure Expand_AST_Packet_Pool
527
     (Requested_Packets : Natural;
528
      Actual_Number     : out Natural;
529
      Total_Number      : out Natural)
530
   is
531
      pragma Unreferenced (Requested_Packets);
532
   begin
533
      --  The AST implementation of GNAT does not permit dynamic expansion
534
      --  of the pool, so we simply add no entries and return the total. If
535
      --  it is necessary to expand the allocation, then this package body
536
      --  must be recompiled with a larger value for AST_Service_Queue_Size.
537
 
538
      Actual_Number := 0;
539
      Total_Number := AST_Service_Queue_Size;
540
   end Expand_AST_Packet_Pool;
541
 
542
   -----------------
543
   -- Process_AST --
544
   -----------------
545
 
546
   procedure Process_AST (Param : Long_Integer) is
547
 
548
      Handler_Data_Ptr : AST_Handler_Data_Ref;
549
      --  This variable is set to the address of the descriptor through
550
      --  which Process_AST is called. Since the descriptor is part of
551
      --  an AST_Handler value, this is also the address of this value,
552
      --  from which we can obtain the task and entry number information.
553
 
554
      function To_Address is new Ada.Unchecked_Conversion
555
        (ST.Task_Id, System.Task_Primitives.Task_Address);
556
 
557
   begin
558
      System.Machine_Code.Asm
559
        (Template => "addq $27,0,%0",
560
         Outputs  => AST_Handler_Data_Ref'Asm_Output ("=r", Handler_Data_Ptr),
561
         Volatile => True);
562
 
563
      System.Machine_Code.Asm
564
        (Template => "ldq $27,%0",
565
         Inputs  => Descriptor_Ref'Asm_Input
566
           ("m", Handler_Data_Ptr.Original_Descriptor_Ref),
567
         Volatile => True);
568
 
569
      AST_Service_Queue (AST_Service_Queue_Put) := AST_Instance'
570
        (Taskid  => Handler_Data_Ptr.Taskid,
571
         Entryno => Handler_Data_Ptr.Entryno,
572
         Param   => Param);
573
 
574
      --  OpenVMS Programming Concepts manual, chapter 8.2.3:
575
      --  "Implicit synchronization can be achieved for data that is shared
576
      --   for write by using only AST routines to write the data, since only
577
      --   one AST can be running at any one time."
578
 
579
      --  This subprogram runs at AST level so is guaranteed to be
580
      --  called sequentially at a given access level.
581
 
582
      AST_Service_Queue_Put := AST_Service_Queue_Put + 1;
583
 
584
      --  Need to wake up processing task. If there is no waiting server
585
      --  then we have temporarily run out, but things should still be
586
      --  OK, since one of the active ones will eventually pick up the
587
      --  service request queued in the AST_Service_Queue.
588
 
589
      for J in 1 .. Num_AST_Servers loop
590
         if Is_Waiting (J) then
591
            Is_Waiting (J) := False;
592
 
593
            --  Sleeps are handled by ASTs on VMS, so don't call Wakeup
594
 
595
            STPOD.Interrupt_AST_Handler (To_Address (AST_Task_Ids (J)));
596
            exit;
597
         end if;
598
      end loop;
599
   end Process_AST;
600
 
601
begin
602
   STPO.Initialize_Lock (AST_Lock'Access, STPO.Global_Task_Level);
603
end System.AST_Handling;

powered by: WebSVN 2.1.0

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