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

⟦fe7464f7e⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_0217d0

Derivation

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

SEPARATE (Transport_Server)
TASK BODY Mutex IS

   All_Pools : Pool_Id := NULL;

   SUBTYPE Worker_List IS Worker_Id;

   Busy_List : Worker_List := NULL;
   Idle_List : Worker_List := NULL;

   Finisher : Worker_Id;

   PROCEDURE Do_Abort (Worker : Worker_Id) IS
   BEGIN
      BEGIN
         ABORT Worker.Worker;
      EXCEPTION
         WHEN OTHERS =>
            NULL;
      END;
      Transport.Close (Worker.Connection);
   END Do_Abort;

   PROCEDURE Do_Abort_List (List : IN OUT Worker_List) IS
   BEGIN
      WHILE List /= NULL LOOP
         Do_Abort (List);
         List := List.Next;
      END LOOP;
   END Do_Abort_List;

   PROCEDURE Destroy_One (Pool : Pool_Id) IS
      Worker : Worker_Id := Busy_List;
   BEGIN
      Pool.Max_Servers := 0;
      WHILE Worker /= NULL LOOP
         IF Worker.Pool = Pool THEN
            Do_Abort (Worker);
         END IF;
         Worker := Worker.Next;
      END LOOP;
   END Destroy_One;

   PROCEDURE Destroy_All IS
      Pool : Pool_Id := All_Pools;
   BEGIN
      WHILE Pool /= NULL LOOP
         Destroy_One (Pool);
         Pool := Pool.Next;
      END LOOP;
   END Destroy_All;

   PROCEDURE Start_Worker (Pool : Pool_Id) IS
      Worker : Worker_Id;
   BEGIN
      IF Pool.Servers < Pool.Max_Servers THEN
         IF Idle_List = NULL THEN
            Worker := NEW Worker_Type;
         ELSE
            Worker    := Idle_List;
            Idle_List := Idle_List.Next;
         END IF;
         Worker.Next := Busy_List;
         Worker.Pool := Pool;
         Worker.Worker.Start (Worker);
         Busy_List    := Worker;
         Pool.Servers := Pool.Servers + 1;
      END IF;
   END Start_Worker;

   PROCEDURE Finish_Worker (Worker : Worker_Id) IS
      Pool : CONSTANT Pool_Id := Worker.Pool;
   BEGIN
      -- extract Worker from Busy_List:
      IF Busy_List = Worker THEN
         Busy_List := Busy_List.Next;
      ELSE
         DECLARE
            Prev : Worker_Id := Busy_List;
         BEGIN
            WHILE Prev.Next /= Worker LOOP
               Prev := Prev.Next;
            END LOOP;
            Prev.Next := Prev.Next.Next;
         END;
      END IF;

      Worker.Next := Idle_List;
      Worker.Pool := NULL;
      Transport.Close (Worker.Connection);
      Idle_List    := Worker;
      Pool.Servers := Pool.Servers - 1;
      IF Pool.Servers = 0 THEN
         Start_Worker (Pool);
      END IF;
   END Finish_Worker;

BEGIN
   LOOP
      BEGIN
         SELECT
            ACCEPT Create (Pool         : OUT Pool_Id;
                           Network      :     Transport_Defs.Network_Name;
                           Local_Socket :     Transport_Defs.Socket_Id;
                           Max_Servers  :     Natural) DO
               DECLARE
                  New_Pool : Pool_Id :=
                     NEW Pool_Type (Network'Length, Local_Socket'Length);
               BEGIN
                  New_Pool.Network      := Network;
                  New_Pool.Local_Socket := Local_Socket;
                  New_Pool.Max_Servers  := Max_Servers;
                  New_Pool.Servers      := 0;
                  New_Pool.Next         := All_Pools;
                  Start_Worker (New_Pool);
                  All_Pools := New_Pool;
                  Pool      := New_Pool;
               END;
            END Create;
         OR
            ACCEPT Set_Max_Servers (Pool : Pool_Id; Max_Servers : Natural) DO
               Pool.Max_Servers := Max_Servers;
            END Set_Max_Servers;
         OR
            ACCEPT Start (Pool : Pool_Id) DO
               Start_Worker (Pool);
            END Start;
         OR
            ACCEPT Finish (Worker : Worker_Id) DO
               Finisher := Worker;
            END Finish;
            Finish_Worker (Finisher);
         OR
            ACCEPT Finalize (Abort_Servers : Boolean) DO
               IF Abort_Servers THEN
                  Do_Abort_List (Busy_List);
               END IF;
               Do_Abort_List (Idle_List);
               Destroy_All;
            END Finalize;
            EXIT;
         END SELECT;
      EXCEPTION
         WHEN OTHERS =>
            NULL;
      END;
   END LOOP;
END Mutex;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=2b rec1=00 rec2=01 rec3=016
        [0x01] rec0=22 rec1=00 rec2=02 rec3=04a
        [0x02] rec0=01 rec1=00 rec2=07 rec3=00c
        [0x03] rec0=1f rec1=00 rec2=03 rec3=08e
        [0x04] rec0=00 rec1=00 rec2=06 rec3=004
        [0x05] rec0=1a rec1=00 rec2=04 rec3=06c
        [0x06] rec0=0f rec1=00 rec2=05 rec3=000
    tail 0x2151ce1c2838e77e89e69 0x489e0066482863c01