|
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 - downloadIndex: ┃ B T ┃
Length: 8047 (0x1f6f)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
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_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;