DataMuseum.dk

top - download

    Length: 3690 (0xe6a)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

WITH Transport_Server_Proc;

PACKAGE BODY Transport_Server IS

   Pool_Is_Destroyed : EXCEPTION;

   TYPE Worker_Type;
   TYPE Worker_Id IS ACCESS Worker_Type;

   TASK TYPE Worker_Task IS
      ENTRY Start (Id : Worker_Id);
   END Worker_Task;

   TYPE Worker_Type IS
      RECORD
         Worker     : Worker_Task;
         Connection : Transport.Connection_Id;
         Pool       : Pool_Id;
         Next       : Worker_Id;
      END RECORD;

   TASK Mutex IS
      ENTRY Create          (Pool         : OUT Pool_Id;
                             Network      :     Transport_Defs.Network_Name;
                             Local_Socket :     Transport_Defs.Socket_Id;
                             Max_Servers  :     Natural);
      ENTRY Set_Max_Servers (Pool : Pool_Id; Max_Servers : Natural);
      ENTRY Start           (Pool : Pool_Id);
      ENTRY Finish          (Worker : Worker_Id);
      ENTRY Finalize        (Abort_Servers : Boolean);
   END Mutex;

   Min_Backoff : CONSTANT Duration := 0.1;
   Max_Backoff : CONSTANT Duration := 5 * 60.0;

   PROCEDURE Do_Backoff (Backoff : IN OUT Duration) IS
   BEGIN
      DELAY Backoff;
      Backoff := 2 * Backoff;
      IF Backoff > Max_Backoff THEN
         Backoff := Max_Backoff;
      END IF;
   END Do_Backoff;

   TASK BODY Mutex IS SEPARATE;

   FUNCTION Create (Network      : Transport_Defs.Network_Name;
                    Local_Socket : Transport_Defs.Socket_Id;
                    Max_Servers  : Natural := Natural'Last) RETURN Pool_Id IS
      Answer : Pool_Id;
   BEGIN
      -- Ignore the Max_Servers parameter due to blocking I/O on target
      -- Mutex.Create (Answer, Network, Local_Socket, Max_Servers);

      Mutex.Create (Answer, Network, Local_Socket, 1);
      RETURN Answer;
   END Create;

   PROCEDURE Set_Max_Servers (Pool : Pool_Id; Max_Servers : Natural) IS
   BEGIN
      --  Ignore Max_Servers parameter due to blocking I/O on the target
      --  Mutex.Set_Max_Servers (Pool, Max_Servers);
      Mutex.Set_Max_Servers (Pool, 1);
   END Set_Max_Servers;

   FUNCTION Network (Pool : Pool_Id) RETURN Transport_Defs.Network_Name IS
   BEGIN
      RETURN Pool.Network;
   END Network;

   FUNCTION Local_Socket (Pool : Pool_Id) RETURN Transport_Defs.Socket_Id IS
   BEGIN
      RETURN Pool.Local_Socket;
   END Local_Socket;

   FUNCTION Max_Servers (Pool : Pool_Id) RETURN Natural IS
   BEGIN
      RETURN Pool.Max_Servers;
   END Max_Servers;

   FUNCTION Servers (Pool : Pool_Id) RETURN Natural IS
   BEGIN
      RETURN Pool.Servers;
   END Servers;

   PROCEDURE Finalize (Abort_Servers : Boolean := False) IS
   BEGIN
      -- Mutex.Finalize (Abort_Servers); JMK 10/25/86 not for native code
      NULL;
   END Finalize;

   PROCEDURE Serve (Pool       : IN OUT Pool_Id;
                    Connection :        Transport.Connection_Id) IS
   BEGIN
      IF Pool.Max_Servers <= 0 THEN
         RAISE Pool_Is_Destroyed;
      END IF;
      Mutex.Start (Pool);
      Serve (Connection);
      IF Pool.Max_Servers <= 0 THEN
         RAISE Pool_Is_Destroyed;
      END IF;
   END Serve;

   PROCEDURE Work IS NEW Transport_Server_Proc (Pool_Id, Serve);

   TASK BODY Worker_Task IS
      Id : Worker_Id;
   BEGIN
      LOOP
         SELECT
            ACCEPT Start (Id : Worker_Id) DO
               Worker_Task.Id := Start.Id;
            END Start;
         OR
            TERMINATE;
         END SELECT;
         BEGIN
            Work (Id.Pool, Id.Connection,
                  Id.Pool.Network, Id.Pool.Local_Socket);
         EXCEPTION
            WHEN Pool_Is_Destroyed =>
               NULL;
         END;
         Mutex.Finish (Id);
      END LOOP;
   END Worker_Task;

END Transport_Server;