|
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: 8515 (0x2143)
Types: TextFile
Names: »B«
└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
└─⟦bb34fe6e2⟧ »DATA«
└─⟦15d8b76c6⟧
└─⟦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.
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);
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_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;
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;