DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦c8374fcd3⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_00b31a

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

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;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=20 rec1=00 rec2=01 rec3=008
        [0x01] rec0=03 rec1=00 rec2=05 rec3=024
        [0x02] rec0=1d rec1=00 rec2=02 rec3=002
        [0x03] rec0=23 rec1=00 rec2=03 rec3=00a
        [0x04] rec0=20 rec1=00 rec2=04 rec3=000
    tail 0x217082b8481fa63e85ce7 0x489e0066482863c01