597 lines
23 KiB
Ada
597 lines
23 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT RUN-TIME COMPONENTS --
|
|
-- --
|
|
-- S Y S T E M . A S T _ H A N D L I N G --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1996-2006 Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
|
-- Boston, MA 02110-1301, USA. --
|
|
-- --
|
|
-- As a special exception, if other files instantiate generics from this --
|
|
-- unit, or you link this unit with other files to produce an executable, --
|
|
-- this unit does not by itself cause the resulting executable to be --
|
|
-- covered by the GNU General Public License. This exception does not --
|
|
-- however invalidate any other reasons why the executable file might be --
|
|
-- covered by the GNU Public License. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
-- This is the OpenVMS/Alpha version.
|
|
|
|
with System; use System;
|
|
|
|
with System.IO;
|
|
|
|
with System.Machine_Code;
|
|
with System.Parameters;
|
|
with System.Storage_Elements;
|
|
|
|
with System.Tasking;
|
|
with System.Tasking.Rendezvous;
|
|
with System.Tasking.Initialization;
|
|
with System.Tasking.Utilities;
|
|
|
|
with System.Task_Primitives;
|
|
with System.Task_Primitives.Operations;
|
|
with System.Task_Primitives.Operations.DEC;
|
|
|
|
-- with Ada.Finalization;
|
|
-- removed, because of problem with controlled attribute ???
|
|
|
|
with Ada.Task_Attributes;
|
|
|
|
with Ada.Exceptions; use Ada.Exceptions;
|
|
|
|
with Ada.Unchecked_Conversion;
|
|
|
|
package body System.AST_Handling is
|
|
|
|
package ATID renames Ada.Task_Identification;
|
|
|
|
package SP renames System.Parameters;
|
|
package ST renames System.Tasking;
|
|
package STR renames System.Tasking.Rendezvous;
|
|
package STI renames System.Tasking.Initialization;
|
|
package STU renames System.Tasking.Utilities;
|
|
|
|
package SSE renames System.Storage_Elements;
|
|
package STPO renames System.Task_Primitives.Operations;
|
|
package STPOD renames System.Task_Primitives.Operations.DEC;
|
|
|
|
AST_Lock : aliased System.Task_Primitives.RTS_Lock;
|
|
-- This is a global lock; it is used to execute in mutual exclusion
|
|
-- from all other AST tasks. It is only used by Lock_AST and
|
|
-- Unlock_AST.
|
|
|
|
procedure Lock_AST (Self_ID : ST.Task_Id);
|
|
-- Locks out other AST tasks. Preceding a section of code by Lock_AST and
|
|
-- following it by Unlock_AST creates a critical region.
|
|
|
|
procedure Unlock_AST (Self_ID : ST.Task_Id);
|
|
-- Releases lock previously set by call to Lock_AST.
|
|
-- All nested locks must be released before other tasks competing for the
|
|
-- tasking lock are released.
|
|
|
|
--------------
|
|
-- Lock_AST --
|
|
--------------
|
|
|
|
procedure Lock_AST (Self_ID : ST.Task_Id) is
|
|
begin
|
|
STI.Defer_Abort_Nestable (Self_ID);
|
|
STPO.Write_Lock (AST_Lock'Access, Global_Lock => True);
|
|
end Lock_AST;
|
|
|
|
----------------
|
|
-- Unlock_AST --
|
|
----------------
|
|
|
|
procedure Unlock_AST (Self_ID : ST.Task_Id) is
|
|
begin
|
|
STPO.Unlock (AST_Lock'Access, Global_Lock => True);
|
|
STI.Undefer_Abort_Nestable (Self_ID);
|
|
end Unlock_AST;
|
|
|
|
---------------------------------
|
|
-- AST_Handler Data Structures --
|
|
---------------------------------
|
|
|
|
-- As noted in the private part of the spec of System.Aux_DEC, the
|
|
-- AST_Handler type is simply a pointer to a procedure that takes
|
|
-- a single 64bit parameter. The following is a local copy
|
|
-- of that definition.
|
|
|
|
-- We need our own copy because we need to get our hands on this
|
|
-- and we cannot see the private part of System.Aux_DEC. We don't
|
|
-- want to be a child of Aux_Dec because of complications resulting
|
|
-- from the use of pragma Extend_System. We will use unchecked
|
|
-- conversions between the two versions of the declarations.
|
|
|
|
type AST_Handler is access procedure (Param : Long_Integer);
|
|
|
|
-- However, this declaration is somewhat misleading, since the values
|
|
-- referenced by AST_Handler values (all produced in this package by
|
|
-- calls to Create_AST_Handler) are highly stylized.
|
|
|
|
-- The first point is that in VMS/Alpha, procedure pointers do not in
|
|
-- fact point to code, but rather to a 48-byte procedure descriptor.
|
|
-- So a value of type AST_Handler is in fact a pointer to one of these
|
|
-- 48-byte descriptors.
|
|
|
|
type Descriptor_Type is new SSE.Storage_Array (1 .. 48);
|
|
for Descriptor_Type'Alignment use Standard'Maximum_Alignment;
|
|
pragma Warnings (Off, Descriptor_Type);
|
|
-- Suppress harmless warnings about alignment.
|
|
-- Should explain why this warning is harmless ???
|
|
|
|
type Descriptor_Ref is access all Descriptor_Type;
|
|
|
|
-- Normally, there is only one such descriptor for a given procedure, but
|
|
-- it works fine to make a copy of the single allocated descriptor, and
|
|
-- use the copy itself, and we take advantage of this in the design here.
|
|
-- The idea is that AST_Handler values will all point to a record with the
|
|
-- following structure:
|
|
|
|
-- Note: When we say it works fine, there is one delicate point, which
|
|
-- is that the code for the AST procedure itself requires the original
|
|
-- descriptor address. We handle this by saving the orignal descriptor
|
|
-- address in this structure and restoring in Process_AST.
|
|
|
|
type AST_Handler_Data is record
|
|
Descriptor : Descriptor_Type;
|
|
Original_Descriptor_Ref : Descriptor_Ref;
|
|
Taskid : ATID.Task_Id;
|
|
Entryno : Natural;
|
|
end record;
|
|
|
|
type AST_Handler_Data_Ref is access all AST_Handler_Data;
|
|
|
|
function To_AST_Handler is new Ada.Unchecked_Conversion
|
|
(AST_Handler_Data_Ref, System.Aux_DEC.AST_Handler);
|
|
|
|
-- Each time Create_AST_Handler is called, a new value of this record
|
|
-- type is created, containing a copy of the procedure descriptor for
|
|
-- the routine used to handle all AST's (Process_AST), and the Task_Id
|
|
-- and entry number parameters identifying the task entry involved.
|
|
|
|
-- The AST_Handler value returned is a pointer to this record. Since
|
|
-- the record starts with the procedure descriptor, it can be used
|
|
-- by the system in the normal way to call the procedure. But now
|
|
-- when the procedure gets control, it can determine the address of
|
|
-- the procedure descriptor used to call it (since the ABI specifies
|
|
-- that this is left sitting in register r27 on entry), and then use
|
|
-- that address to retrieve the Task_Id and entry number so that it
|
|
-- knows on which entry to queue the AST request.
|
|
|
|
-- The next issue is where are these records placed. Since we intend
|
|
-- to pass pointers to these records to asynchronous system service
|
|
-- routines, they have to be on the heap, which means we have to worry
|
|
-- about when to allocate them and deallocate them.
|
|
|
|
-- We solve this problem by introducing a task attribute that points to
|
|
-- a vector, indexed by the entry number, of AST_Handler_Data records
|
|
-- for a given task. The pointer itself is a controlled object allowing
|
|
-- us to write a finalization routine that frees the referenced vector.
|
|
|
|
-- An entry in this vector is either initialized (Entryno non-zero) and
|
|
-- can be used for any subsequent reference to the same entry, or it is
|
|
-- unused, marked by the Entryno value being zero.
|
|
|
|
type AST_Handler_Vector is array (Natural range <>) of AST_Handler_Data;
|
|
type AST_Handler_Vector_Ref is access all AST_Handler_Vector;
|
|
|
|
-- type AST_Vector_Ptr is new Ada.Finalization.Controlled with record
|
|
-- removed due to problem with controlled attribute, consequence is that
|
|
-- we have a memory leak if a task that has AST attribute entries is
|
|
-- terminated. ???
|
|
|
|
type AST_Vector_Ptr is record
|
|
Vector : AST_Handler_Vector_Ref;
|
|
end record;
|
|
|
|
AST_Vector_Init : AST_Vector_Ptr;
|
|
-- Initial value, treated as constant, Vector will be null.
|
|
|
|
package AST_Attribute is new Ada.Task_Attributes
|
|
(Attribute => AST_Vector_Ptr,
|
|
Initial_Value => AST_Vector_Init);
|
|
|
|
use AST_Attribute;
|
|
|
|
-----------------------
|
|
-- AST Service Queue --
|
|
-----------------------
|
|
|
|
-- The following global data structures are used to queue pending
|
|
-- AST requests. When an AST is signalled, the AST service routine
|
|
-- Process_AST is called, and it makes an entry in this structure.
|
|
|
|
type AST_Instance is record
|
|
Taskid : ATID.Task_Id;
|
|
Entryno : Natural;
|
|
Param : Long_Integer;
|
|
end record;
|
|
-- The Taskid and Entryno indicate the entry on which this AST is to
|
|
-- be queued, and Param is the parameter provided from the AST itself.
|
|
|
|
AST_Service_Queue_Size : constant := 256;
|
|
AST_Service_Queue_Limit : constant := 250;
|
|
type AST_Service_Queue_Index is mod AST_Service_Queue_Size;
|
|
-- Index used to refer to entries in the circular buffer which holds
|
|
-- active AST_Instance values. The upper bound reflects the maximum
|
|
-- number of AST instances that can be stored in the buffer. Since
|
|
-- these entries are immediately serviced by the high priority server
|
|
-- task that does the actual entry queuing, it is very unusual to have
|
|
-- any significant number of entries simulaneously queued.
|
|
|
|
AST_Service_Queue : array (AST_Service_Queue_Index) of AST_Instance;
|
|
pragma Volatile_Components (AST_Service_Queue);
|
|
-- The circular buffer used to store active AST requests.
|
|
|
|
AST_Service_Queue_Put : AST_Service_Queue_Index := 0;
|
|
AST_Service_Queue_Get : AST_Service_Queue_Index := 0;
|
|
pragma Atomic (AST_Service_Queue_Put);
|
|
pragma Atomic (AST_Service_Queue_Get);
|
|
-- These two variables point to the next slots in the AST_Service_Queue
|
|
-- to be used for putting a new entry in and taking an entry out. This
|
|
-- is a circular buffer, so these pointers wrap around. If the two values
|
|
-- are equal the buffer is currently empty. The pointers are atomic to
|
|
-- ensure proper synchronization between the single producer (namely the
|
|
-- Process_AST procedure), and the single consumer (the AST_Service_Task).
|
|
|
|
--------------------------------
|
|
-- AST Server Task Structures --
|
|
--------------------------------
|
|
|
|
-- The basic approach is that when an AST comes in, a call is made to
|
|
-- the Process_AST procedure. It queues the request in the service queue
|
|
-- and then wakes up an AST server task to perform the actual call to the
|
|
-- required entry. We use this intermediate server task, since the AST
|
|
-- procedure itself cannot wait to return, and we need some caller for
|
|
-- the rendezvous so that we can use the normal rendezvous mechanism.
|
|
|
|
-- It would work to have only one AST server task, but then we would lose
|
|
-- all overlap in AST processing, and furthermore, we could get priority
|
|
-- inversion effects resulting in starvation of AST requests.
|
|
|
|
-- We therefore maintain a small pool of AST server tasks. We adjust
|
|
-- the size of the pool dynamically to reflect traffic, so that we have
|
|
-- a sufficient number of server tasks to avoid starvation.
|
|
|
|
Max_AST_Servers : constant Natural := 16;
|
|
-- Maximum number of AST server tasks that can be allocated
|
|
|
|
Num_AST_Servers : Natural := 0;
|
|
-- Number of AST server tasks currently active
|
|
|
|
Num_Waiting_AST_Servers : Natural := 0;
|
|
-- This is the number of AST server tasks that are either waiting for
|
|
-- work, or just about to go to sleep and wait for work.
|
|
|
|
Is_Waiting : array (1 .. Max_AST_Servers) of Boolean := (others => False);
|
|
-- An array of flags showing which AST server tasks are currently waiting
|
|
|
|
AST_Task_Ids : array (1 .. Max_AST_Servers) of ST.Task_Id;
|
|
-- Task Id's of allocated AST server tasks
|
|
|
|
task type AST_Server_Task (Num : Natural) is
|
|
pragma Priority (Priority'Last);
|
|
end AST_Server_Task;
|
|
-- Declaration for AST server task. This task has no entries, it is
|
|
-- controlled by sleep and wakeup calls at the task primitives level.
|
|
|
|
type AST_Server_Task_Ptr is access all AST_Server_Task;
|
|
-- Type used to allocate server tasks
|
|
|
|
-----------------------
|
|
-- Local Subprograms --
|
|
-----------------------
|
|
|
|
procedure Allocate_New_AST_Server;
|
|
-- Allocate an additional AST server task
|
|
|
|
procedure Process_AST (Param : Long_Integer);
|
|
-- This is the central routine for processing all AST's, it is referenced
|
|
-- as the code address of all created AST_Handler values. See detailed
|
|
-- description in body to understand how it works to have a single such
|
|
-- procedure for all AST's even though it does not get any indication of
|
|
-- the entry involved passed as an explicit parameter. The single explicit
|
|
-- parameter Param is the parameter passed by the system with the AST.
|
|
|
|
-----------------------------
|
|
-- Allocate_New_AST_Server --
|
|
-----------------------------
|
|
|
|
procedure Allocate_New_AST_Server is
|
|
Dummy : AST_Server_Task_Ptr;
|
|
pragma Unreferenced (Dummy);
|
|
|
|
begin
|
|
if Num_AST_Servers = Max_AST_Servers then
|
|
return;
|
|
|
|
else
|
|
-- Note: it is safe to increment Num_AST_Servers immediately, since
|
|
-- no one will try to activate this task until it indicates that it
|
|
-- is sleeping by setting its entry in Is_Waiting to True.
|
|
|
|
Num_AST_Servers := Num_AST_Servers + 1;
|
|
Dummy := new AST_Server_Task (Num_AST_Servers);
|
|
end if;
|
|
end Allocate_New_AST_Server;
|
|
|
|
---------------------
|
|
-- AST_Server_Task --
|
|
---------------------
|
|
|
|
task body AST_Server_Task is
|
|
Taskid : ATID.Task_Id;
|
|
Entryno : Natural;
|
|
Param : aliased Long_Integer;
|
|
Self_Id : constant ST.Task_Id := ST.Self;
|
|
|
|
pragma Volatile (Param);
|
|
|
|
begin
|
|
-- By making this task independent of master, when the environment
|
|
-- task is finalizing, the AST_Server_Task will be notified that it
|
|
-- should terminate.
|
|
|
|
STU.Make_Independent;
|
|
|
|
-- Record our task Id for access by Process_AST
|
|
|
|
AST_Task_Ids (Num) := Self_Id;
|
|
|
|
-- Note: this entire task operates with the main task lock set, except
|
|
-- when it is sleeping waiting for work, or busy doing a rendezvous
|
|
-- with an AST server. This lock protects the data structures that
|
|
-- are shared by multiple instances of the server task.
|
|
|
|
Lock_AST (Self_Id);
|
|
|
|
-- This is the main infinite loop of the task. We go to sleep and
|
|
-- wait to be woken up by Process_AST when there is some work to do.
|
|
|
|
loop
|
|
Num_Waiting_AST_Servers := Num_Waiting_AST_Servers + 1;
|
|
|
|
Unlock_AST (Self_Id);
|
|
|
|
STI.Defer_Abort (Self_Id);
|
|
|
|
if SP.Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
|
|
STPO.Write_Lock (Self_Id);
|
|
|
|
Is_Waiting (Num) := True;
|
|
|
|
Self_Id.Common.State := ST.AST_Server_Sleep;
|
|
STPO.Sleep (Self_Id, ST.AST_Server_Sleep);
|
|
Self_Id.Common.State := ST.Runnable;
|
|
|
|
STPO.Unlock (Self_Id);
|
|
|
|
if SP.Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
end if;
|
|
|
|
-- If the process is finalizing, Undefer_Abort will simply end
|
|
-- this task.
|
|
|
|
STI.Undefer_Abort (Self_Id);
|
|
|
|
-- We are awake, there is something to do!
|
|
|
|
Lock_AST (Self_Id);
|
|
Num_Waiting_AST_Servers := Num_Waiting_AST_Servers - 1;
|
|
|
|
-- Loop here to service outstanding requests. We are always
|
|
-- locked on entry to this loop.
|
|
|
|
while AST_Service_Queue_Get /= AST_Service_Queue_Put loop
|
|
Taskid := AST_Service_Queue (AST_Service_Queue_Get).Taskid;
|
|
Entryno := AST_Service_Queue (AST_Service_Queue_Get).Entryno;
|
|
Param := AST_Service_Queue (AST_Service_Queue_Get).Param;
|
|
|
|
AST_Service_Queue_Get := AST_Service_Queue_Get + 1;
|
|
|
|
-- This is a manual expansion of the normal call simple code
|
|
|
|
declare
|
|
type AA is access all Long_Integer;
|
|
P : AA := Param'Unrestricted_Access;
|
|
|
|
function To_ST_Task_Id is new Ada.Unchecked_Conversion
|
|
(ATID.Task_Id, ST.Task_Id);
|
|
|
|
begin
|
|
Unlock_AST (Self_Id);
|
|
STR.Call_Simple
|
|
(Acceptor => To_ST_Task_Id (Taskid),
|
|
E => ST.Task_Entry_Index (Entryno),
|
|
Uninterpreted_Data => P'Address);
|
|
|
|
exception
|
|
when E : others =>
|
|
System.IO.Put_Line ("%Debugging event");
|
|
System.IO.Put_Line (Exception_Name (E) &
|
|
" raised when trying to deliver an AST.");
|
|
|
|
if Exception_Message (E)'Length /= 0 then
|
|
System.IO.Put_Line (Exception_Message (E));
|
|
end if;
|
|
|
|
System.IO.Put_Line ("Task type is " & "Receiver_Type");
|
|
System.IO.Put_Line ("Task id is " & ATID.Image (Taskid));
|
|
end;
|
|
|
|
Lock_AST (Self_Id);
|
|
end loop;
|
|
end loop;
|
|
end AST_Server_Task;
|
|
|
|
------------------------
|
|
-- Create_AST_Handler --
|
|
------------------------
|
|
|
|
function Create_AST_Handler
|
|
(Taskid : ATID.Task_Id;
|
|
Entryno : Natural) return System.Aux_DEC.AST_Handler
|
|
is
|
|
Attr_Ref : Attribute_Handle;
|
|
|
|
Process_AST_Ptr : constant AST_Handler := Process_AST'Access;
|
|
-- Reference to standard procedure descriptor for Process_AST
|
|
|
|
function To_Descriptor_Ref is new Ada.Unchecked_Conversion
|
|
(AST_Handler, Descriptor_Ref);
|
|
|
|
Original_Descriptor_Ref : constant Descriptor_Ref :=
|
|
To_Descriptor_Ref (Process_AST_Ptr);
|
|
|
|
begin
|
|
if ATID.Is_Terminated (Taskid) then
|
|
raise Program_Error;
|
|
end if;
|
|
|
|
Attr_Ref := Reference (Taskid);
|
|
|
|
-- Allocate another server if supply is getting low
|
|
|
|
if Num_Waiting_AST_Servers < 2 then
|
|
Allocate_New_AST_Server;
|
|
end if;
|
|
|
|
-- No point in creating more if we have zillions waiting to
|
|
-- be serviced.
|
|
|
|
while AST_Service_Queue_Put - AST_Service_Queue_Get
|
|
> AST_Service_Queue_Limit
|
|
loop
|
|
delay 0.01;
|
|
end loop;
|
|
|
|
-- If no AST vector allocated, or the one we have is too short, then
|
|
-- allocate one of right size and initialize all entries except the
|
|
-- one we will use to unused. Note that the assignment automatically
|
|
-- frees the old allocated table if there is one.
|
|
|
|
if Attr_Ref.Vector = null
|
|
or else Attr_Ref.Vector'Length < Entryno
|
|
then
|
|
Attr_Ref.Vector := new AST_Handler_Vector (1 .. Entryno);
|
|
|
|
for E in 1 .. Entryno loop
|
|
Attr_Ref.Vector (E).Descriptor :=
|
|
Original_Descriptor_Ref.all;
|
|
Attr_Ref.Vector (E).Original_Descriptor_Ref :=
|
|
Original_Descriptor_Ref;
|
|
Attr_Ref.Vector (E).Taskid := Taskid;
|
|
Attr_Ref.Vector (E).Entryno := E;
|
|
end loop;
|
|
end if;
|
|
|
|
return To_AST_Handler (Attr_Ref.Vector (Entryno)'Unrestricted_Access);
|
|
end Create_AST_Handler;
|
|
|
|
----------------------------
|
|
-- Expand_AST_Packet_Pool --
|
|
----------------------------
|
|
|
|
procedure Expand_AST_Packet_Pool
|
|
(Requested_Packets : Natural;
|
|
Actual_Number : out Natural;
|
|
Total_Number : out Natural)
|
|
is
|
|
pragma Unreferenced (Requested_Packets);
|
|
begin
|
|
-- The AST implementation of GNAT does not permit dynamic expansion
|
|
-- of the pool, so we simply add no entries and return the total. If
|
|
-- it is necessary to expand the allocation, then this package body
|
|
-- must be recompiled with a larger value for AST_Service_Queue_Size.
|
|
|
|
Actual_Number := 0;
|
|
Total_Number := AST_Service_Queue_Size;
|
|
end Expand_AST_Packet_Pool;
|
|
|
|
-----------------
|
|
-- Process_AST --
|
|
-----------------
|
|
|
|
procedure Process_AST (Param : Long_Integer) is
|
|
|
|
Handler_Data_Ptr : AST_Handler_Data_Ref;
|
|
-- This variable is set to the address of the descriptor through
|
|
-- which Process_AST is called. Since the descriptor is part of
|
|
-- an AST_Handler value, this is also the address of this value,
|
|
-- from which we can obtain the task and entry number information.
|
|
|
|
function To_Address is new Ada.Unchecked_Conversion
|
|
(ST.Task_Id, System.Address);
|
|
|
|
begin
|
|
System.Machine_Code.Asm
|
|
(Template => "addl $27,0,%0",
|
|
Outputs => AST_Handler_Data_Ref'Asm_Output ("=r", Handler_Data_Ptr),
|
|
Volatile => True);
|
|
|
|
System.Machine_Code.Asm
|
|
(Template => "ldl $27,%0",
|
|
Inputs => Descriptor_Ref'Asm_Input
|
|
("m", Handler_Data_Ptr.Original_Descriptor_Ref),
|
|
Volatile => True);
|
|
|
|
AST_Service_Queue (AST_Service_Queue_Put) := AST_Instance'
|
|
(Taskid => Handler_Data_Ptr.Taskid,
|
|
Entryno => Handler_Data_Ptr.Entryno,
|
|
Param => Param);
|
|
|
|
-- OpenVMS Programming Concepts manual, chapter 8.2.3:
|
|
-- "Implicit synchronization can be achieved for data that is shared
|
|
-- for write by using only AST routines to write the data, since only
|
|
-- one AST can be running at any one time."
|
|
|
|
-- This subprogram runs at AST level so is guaranteed to be
|
|
-- called sequentially at a given access level.
|
|
|
|
AST_Service_Queue_Put := AST_Service_Queue_Put + 1;
|
|
|
|
-- Need to wake up processing task. If there is no waiting server
|
|
-- then we have temporarily run out, but things should still be
|
|
-- OK, since one of the active ones will eventually pick up the
|
|
-- service request queued in the AST_Service_Queue.
|
|
|
|
for J in 1 .. Num_AST_Servers loop
|
|
if Is_Waiting (J) then
|
|
Is_Waiting (J) := False;
|
|
|
|
-- Sleeps are handled by ASTs on VMS, so don't call Wakeup.
|
|
|
|
STPOD.Interrupt_AST_Handler (To_Address (AST_Task_Ids (J)));
|
|
exit;
|
|
end if;
|
|
end loop;
|
|
end Process_AST;
|
|
|
|
begin
|
|
STPO.Initialize_Lock (AST_Lock'Access, STPO.Global_Task_Level);
|
|
end System.AST_Handling;
|