|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 9937 (0x26d1)
Types: TextFile
Names: »B«
└─⟦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⟧
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;