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

Subversion Repositories openrisc

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

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

powered by: WebSVN 2.1.0

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