⟦9b303a4c4⟧

E3 Source Code



WITH Pragma_Assert;

SEPARATE (Transport_Stream)
TASK BODY Worker IS

   All_Pools : Pool_List := NULL;

   -- This is a terrible structure.  To speed up allocation,
   -- there should be a hash table on remote address for pools
   -- which have null local_socket_ids.  Someday.

   Free_Streams : Stream_List := NULL;

   Last_Unique_Id : Unique_Id := 0;

   FUNCTION Next_Unique_Id RETURN Unique_Id IS
   BEGIN
      IF Last_Unique_Id = Unique_Id'Last THEN
         Last_Unique_Id := Null_Unique_Id + 1;
      ELSE
         Last_Unique_Id := Last_Unique_Id + 1;
      END IF;

      RETURN Last_Unique_Id;
   END Next_Unique_Id;

   PROCEDURE Do_Create (Pool          : OUT Pool_Id;
                        Network       :     Transport_Defs.Network_Name;
                        Remote_Host   :     Transport_Defs.Host_Id;
                        Remote_Socket :     Transport_Defs.Socket_Id;
                        Local_Socket  :     Transport_Defs.Socket_Id) IS
      New_Pool : Pool_Id;
   BEGIN
      New_Pool := NEW Pool_Type (Network_Length       => Network'Length,
                                 Remote_Host_Length   => Remote_Host'Length,
                                 Remote_Socket_Length => Remote_Socket'Length,
                                 Local_Socket_Length  => Local_Socket'Length);
      New_Pool.Idle := NULL;
      New_Pool.Network := Network;
      New_Pool.Remote_Host := Remote_Host;
      New_Pool.Remote_Socket := Remote_Socket;
      New_Pool.Local_Socket := Local_Socket;
      New_Pool.Next := All_Pools;
      All_Pools := Pool_List (New_Pool);
      Pool := New_Pool;
   END Do_Create;

   PROCEDURE Do_Allocate (Stream : OUT Stream_Id) IS
      New_Stream : Stream_List;
   BEGIN
      IF Free_Streams = NULL THEN
         New_Stream        := NEW Stream_Type;
         New_Stream.Unique := Next_Unique_Id;
      ELSE
         New_Stream   := Free_Streams;
         Free_Streams := New_Stream.Next;
      END IF;

      New_Stream.Next := NULL;
      New_Stream.Pool := NULL;
      Initialize (New_Stream.Transmit);
      Initialize (New_Stream.Receive);
      Stream := (New_Stream, New_Stream.Unique);
   END Do_Allocate;

   PROCEDURE Do_Allocate (Stream : OUT Stream_Id; Pool : Pool_Id) IS
      New_Stream : Stream_Id;
   BEGIN
      IF Pool.Idle = NULL THEN
         Do_Allocate (New_Stream);
         New_Stream.Stream.Pool := Pool;
      ELSE
         New_Stream := (Pool.Idle, Pool.Idle.Unique);
         Pool.Idle  := Pool.Idle.Next;
--         PRAGMA Assert (New_Stream.Stream.Pool = Pool);
         Pragma_Assert.Check (New_Stream.Stream.Pool = Pool);
      END IF;

      Stream := New_Stream;
   END Do_Allocate;

   PROCEDURE Do_Allocate (Stream        : OUT Stream_Id;
                          Network       :     Transport_Defs.Network_Name;
                          Remote_Host   :     Transport_Defs.Host_Id;
                         Remote_Socket :     Transport_Defs.Socket_Id) IS
      Pool : Pool_List;
   BEGIN
      Pool := All_Pools;

      LOOP
         EXIT WHEN Pool = NULL;
         EXIT WHEN Equals (Network, Pool.Network) AND THEN
                      Equals (Remote_Host, Pool.Remote_Host) AND THEN
                      Equals (Remote_Socket, Pool.Remote_Socket) AND THEN
                      Equals (Null_Socket_Id, Pool.Local_Socket);
         Pool := Pool.Next;
      END LOOP;

      IF Pool = NULL THEN
         Do_Create (Pool_Id (Pool), Network, Remote_Host, Remote_Socket,
                    Local_Socket => Null_Socket_Id);
      END IF;

      Do_Allocate (Stream, Pool_Id (Pool));
   END Do_Allocate;

   PROCEDURE Do_Scavenge (Stream : Stream_List) IS
   BEGIN
      Stream.Unique := Next_Unique_Id;  -- invalidate dangling references.
      Transport.Close (Stream.Connection);
      Stream.Next  := Free_Streams;
      Free_Streams := Stream;
   END Do_Savenge;

   PROCEDURE Do_Deallocate (Stream : Stream_Id) IS
      List : Stream_List;
      Pool : Pool_Id;
   BEGIN
      IF NOT Is_Null (Stream) THEN
         List := Stream.Stream;
         Pool := List.Pool;

         IF Pool = NULL THEN
            Do_Scavenge (List);
         ELSE
            List.Unique     := Next_Unique_Id;  -- invalidate references
            List.Referenced := True;
            List.Next       := Pool.Idle;
            Pool.Idle       := List;
         END IF;
      END IF;
   END Do_Deallocate;

   PROCEDURE Do_Scavenge (Stream : Stream_Id) IS
   BEGIN
      IF NOT Is_Null (Stream) THEN
         Do_Scavenge (Stream.Stream);
      END IF;
   END Do_Scavenge;

   PROCEDURE Do_Scavenge (Pool : Pool_Id) IS
      X, Y : Stream_List;
   BEGIN
      -- scavenge the beginning of the list:
      X := Pool.Idle;

      WHILE X /= NULL LOOP
         IF X.Referenced THEN
            X.Referenced := False;
            EXIT;
         ELSE
            Pool.Idle := X.Next;
            Do_Scavenge (X);
            X := Pool.Idle;
         END IF;
      END LOOP;

      -- scavenge the rest of the list:
      X := Pool.Idle;

      WHILE X /= NULL LOOP
         Y := X.Next;
         EXIT WHEN Y = NULL;

         IF Y.Referenced THEN
            Y.Referenced := False;
            X            := Y;
         ELSE
            X.Next := Y.Next;
            Do_Scavenge (Y);
         END IF;
      END LOOP;
   END Do_Scavenge;

   PROCEDURE Do_Scavenge IS
      X : Pool_List;
   BEGIN
      X := All_Pools;

      WHILE X /= NULL LOOP
         Do_Scavenge (Pool_Id (X));
         X := X.Next;
      END LOOP;
   END Do_Scavenge;

BEGIN
   LOOP
      BEGIN
         LOOP
            SELECT
               ACCEPT Create (Pool          : OUT Pool_Id;
                              Network       :     Transport_Defs.Network_Name;
                              Remote_Host   :     Transport_Defs.Host_Id;
                              Remote_Socket :     Transport_Defs.Socket_Id;
                              Local_Socket  :     Transport_Defs.Socket_Id) DO
                  Do_Create (Pool, Network, Remote_Host,
                             Remote_Socket, Local_Socket);
               END Create;
            OR
               ACCEPT Allocate (Stream : OUT Stream_Id) DO
                  Do_Allocate (Stream);
               END Allocate;
            OR
               ACCEPT Allocate (Stream : OUT Stream_Id; Pool : Pool_Id) DO
                  Do_Allocate (Stream, Pool);
               END Allocate;
            OR
               ACCEPT Allocate (Stream        : OUT Stream_Id;
                                Network       : Transport_Defs.Network_Name;
                                Remote_Host   : Transport_Defs.Host_Id;
                                Remote_Socket : Transport_Defs.Socket_Id) DO
                  Do_Allocate (Stream, Network, Remote_Host, Remote_Socket);
               END Allocate;

            OR
               ACCEPT Deallocate (Stream : Stream_Id) DO
                  Do_Deallocate (Stream);
               END Deallocate;
            OR
               ACCEPT Disconnect (Stream : Stream_Id) DO
                  Do_Scavenge (Stream);
               END Disconnect;
            OR
               ACCEPT Scavenge (Pool : Pool_Id := NULL) DO
                  IF Pool = NULL THEN
                     Do_Scavenge;
                  ELSE
                     Do_Scavenge (Pool);
                  END IF;
               END Scavenge;
            OR
               ACCEPT Destroy (Pool : Pool_Id := NULL) DO
                  IF Pool = NULL THEN
                     Do_Scavenge;
                     Do_Scavenge;
                  ELSE
                     Do_Scavenge (Pool);
                     Do_Scavenge (Pool);
                  END IF;
               END Destroy;
            OR
               ACCEPT Finalize DO
                  Do_Scavenge;
                  Do_Scavenge;
               END Finalize;

               EXIT;
            OR
               TERMINATE;
            END SELECT;
         END LOOP;

         EXIT;
      EXCEPTION
         WHEN OTHERS =>
            NULL;
      END;
   END LOOP;
END Worker;
DataMuseum.dk

Rational R1000/400

⟦9b303a4c4⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
