DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦b2f7d9f73⟧ TextFile

    Length: 9937 (0x26d1)
    Types: TextFile
    Names: »B«

Derivation

└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS 
    └─ ⟦91c658230⟧ »DATA« 
        └─⟦458657fb6⟧ 
            └─⟦a5bbbb819⟧ 
                └─⟦this⟧ 
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
    └─ ⟦fc9b38f02⟧ »DATA« 
        └─⟦9b46a407a⟧ 
            └─⟦eec0a994f⟧ 
                └─⟦this⟧ 

TextFile

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.

    All_Pools_Empty : Boolean := True; -- JMK 9/4/86
    -- No pool contains any idle streams.
    -- When true, it's safe to terminate.

    Free_Streams : Stream_List := null;

    My_Job_Id : Machine.Job_Id  
        := Machine.Get_Job_Id (Machine.Get_Task_Id);

    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);  
        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 (Transport_Defs.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 => Transport_Defs.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.Disconnect (Stream.Connection); -- JMK 2/13/87
        Transport.Close (Stream.Connection);  
        Stream.Next := Free_Streams;  
        Free_Streams := Stream;  
    end Do_Scavenge;

    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;  
                Transport.Set_Owner -- JMK 10/27/86
                   (List.Connection, My_Job_Id);
                -- JMK 9/4/86:
                if All_Pools_Empty then  
                    All_Pools_Empty := False;  
                    Scavenger.Start;  
                end if;  
            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;  
                All_Pools_Empty := False; -- JMK 9/4/86
                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  
        All_Pools_Empty := True; -- JMK 9/4/86
        X := All_Pools;  
        while X /= null loop  
            Do_Scavenge (Pool_Id (X));  
            X := X.Next;  
        end loop;  
    end Do_Scavenge;

begin  
    loop  
        begin  
            loop  
                if All_Pools_Empty then  
                    Scavenger.Stop; -- JMK 9/4/86
                end if;

                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  
                    when All_Pools_Empty =>  
                        terminate;  
                end select;  
            end loop;  
            exit;  
        exception  
            when others =>  
                null;  
        end;  
    end loop;  
end Worker;