|
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: 8565 (0x2175)
Types: TextFile
Names: »B«
└─⟦bfaa708f6⟧ Bits:30000531 8mm tape, Rational 1000, INSIGHT 1_3_0
└─ ⟦c51948655⟧ »DATA«
└─⟦266b31e86⟧
└─⟦this⟧
with Client;
with Queue_Generic;
with Network;
with Log_Writer;
with Message;
package body Message_Dispatch is
package Packet_Queue is new Queue_Generic (Message.Packet);
task Message_Multiplexor is
entry Receive (Client.Id) (Pkt : out Message.Packet);
entry Send (Destination : Client.Id; Pkt : Message.Packet);
end Message_Multiplexor;
task Buffer_Pool_Manager is
entry Free (Pkt : Message.Packet);
entry Allocate (Pkt : out Message.Packet);
end Buffer_Pool_Manager;
task Message_Mover;
procedure Get_Message (Client_Name : Client.Id;
Packet : out Message.Packet) is
begin
Message_Multiplexor.Receive (Client_Name) (Packet);
null;
end Get_Message;
procedure Free_Buffer (Pkt : Message.Packet) is
begin
Buffer_Pool_Manager.Free (Pkt);
end Free_Buffer;
task body Buffer_Pool_Manager is
Buffer_Queue : Packet_Queue.Queue;
begin
Packet_Queue.Initialize (Buffer_Queue);
loop
begin
select
accept Allocate (Pkt : out Message.Packet) do
if Packet_Queue.Is_Empty (Buffer_Queue) then
declare
The_Packet : Message.Packet;
begin
Message.Initialize (The_Packet, Client.Nil);
Pkt := The_Packet;
end;
else
Pkt := Packet_Queue.First (Buffer_Queue);
Packet_Queue.Delete (Buffer_Queue);
end if;
end Allocate;
or
accept Free (Pkt : Message.Packet) do
Packet_Queue.Add (Buffer_Queue, Pkt);
end Free;
end select;
exception
when others =>
Log_Writer.Log_Message
("Dispatch.Buffer_Pool_Manager", "exception!");
delay 5.0;
end;
end loop;
end Buffer_Pool_Manager;
task body Message_Multiplexor is
Client_Queues : array (Client.Id) of Packet_Queue.Queue;
begin
for I in Client_Queues'Range loop
Packet_Queue.Initialize (Client_Queues (I));
end loop;
loop
begin
select
when not Packet_Queue.Is_Empty (Client_Queues (1)) =>
accept Receive (1) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (1));
Packet_Queue.Delete (Client_Queues (1));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (2)) =>
accept Receive (2) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (2));
Packet_Queue.Delete (Client_Queues (2));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (3)) =>
accept Receive (3) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (3));
Packet_Queue.Delete (Client_Queues (3));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (4)) =>
accept Receive (4) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (4));
Packet_Queue.Delete (Client_Queues (4));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (5)) =>
accept Receive (5) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (5));
Packet_Queue.Delete (Client_Queues (5));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (6)) =>
accept Receive (6) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (6));
Packet_Queue.Delete (Client_Queues (6));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (7)) =>
accept Receive (7) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (7));
Packet_Queue.Delete (Client_Queues (7));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (8)) =>
accept Receive (8) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (8));
Packet_Queue.Delete (Client_Queues (8));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (9)) =>
accept Receive (9) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (9));
Packet_Queue.Delete (Client_Queues (9));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (10)) =>
accept Receive (10) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (10));
Packet_Queue.Delete (Client_Queues (10));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (11)) =>
accept Receive (11) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (11));
Packet_Queue.Delete (Client_Queues (11));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (12)) =>
accept Receive (12) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (12));
Packet_Queue.Delete (Client_Queues (12));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (13)) =>
accept Receive (13) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (13));
Packet_Queue.Delete (Client_Queues (13));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (14)) =>
accept Receive (14) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (14));
Packet_Queue.Delete (Client_Queues (14));
end Receive;
or
when not Packet_Queue.Is_Empty (Client_Queues (15)) =>
accept Receive (15) (Pkt : out Message.Packet) do
Pkt := Packet_Queue.First (Client_Queues (15));
Packet_Queue.Delete (Client_Queues (15));
end Receive;
or
accept Send (Destination : Client.Id;
Pkt : Message.Packet) do
Packet_Queue.Add (Client_Queues (Destination), Pkt);
end Send;
end select;
exception
when others =>
Log_Writer.Log_Message
("Message_Dispatch.Message_Multiplexor", "exception");
delay 5.0; -- Don't go into an infinite loop!
end;
end loop;
end Message_Multiplexor;
task body Message_Mover is
P : Message.Packet;
begin
loop
Buffer_Pool_Manager.Allocate (P);
Network.Receive (P);
Message_Multiplexor.Send (Message.Destination (P), P);
end loop;
end Message_Mover;
end Message_Dispatch;