|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5120 (0x1400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Producer_B, seg_020b34
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Producer_B_Messages;
with Mail;
procedure Producer_B is
use Producer_B_Messages.Predefined_Ops;
Unexpected_Message : exception;
Poor_Reply : exception;
Out_Message : Producer_B_Messages.Message :=
Producer_B_Messages.Message (True);
Priority : Mail.Priority := Mail.Priority (1);
Box : Mail.Mailbox := Mail.Look_Up ("consumer1");
Local_Mailbox : Mail.Mailbox := Mail.Look_Up ("producer_b");
Boxes : Mail.List;
Trans_Id : Mail.Transaction_Id;
procedure Toggle (M : in out Producer_B_Messages.Message) is
begin
M := not M;
end Toggle;
procedure Process_Type_B_Reply (M : in Producer_B_Messages.Reply) is
begin
if Producer_B_Messages.Message'Pos (Out_Message) /= Integer (M) then
raise Poor_Reply;
end if;
end Process_Type_B_Reply;
procedure Process_Incoming_Messages (M : Mail.Raw_Message) is
begin
if Mail.Is_A_Reply (M) then
case Mail.Get_Kind (M) is
when Producer_B_Messages.Reply_Kind =>
Process_Type_B_Reply
(Producer_B_Messages.Reply_Op.Receive (M));
when others =>
null;
end case;
else
raise Unexpected_Message;
end if;
end Process_Incoming_Messages;
begin
-- construct list of mailboxes for multicast
Mail.Add (Box, Boxes);
Mail.Add (Box => Mail.Look_Up ("consumer2"), To => Boxes);
Mail.Add (Box => Mail.Look_Up ("consumer3"), To => Boxes);
for I in 1 .. 500 loop
--------------------------------------------------
-- issue all types of sends
--------------------------------------------------
Producer_B_Messages.Op.Send_With_Delivery_Completion
(The_Message => Out_Message,
Message_Priority => Priority,
Destination => Box);
-- construct new message
Toggle (Out_Message);
-- send a msg waiting for a reply
Process_Type_B_Reply (Producer_B_Messages.Reply_Op.
Send_Blocked_With_Application_Reply
(The_Message => Out_Message,
Message_Priority => Priority,
Destination => Box));
-- construct new message
Toggle (Out_Message);
-- send a nonblocked msg with a reply
Trans_Id := Producer_B_Messages.Reply_Op.
Send_Nonblocked_With_Application_Reply
(The_Message => Out_Message,
Message_Priority => Priority,
Source => Local_Mailbox,
Destination => Box);
-- do some processing
null;
-- wait for reply
Process_Incoming_Messages (Mail.Wait (Box => Local_Mailbox));
-- construct new message
Toggle (Out_Message);
Producer_B_Messages.Op.Multicast (The_Message => Out_Message,
Message_Priority => Priority,
Destinations => Boxes);
-- construct new message
Toggle (Out_Message);
Producer_B_Messages.Op.Broadcast
(The_Message => Out_Message, Message_Priority => Priority);
-- construct new message
Toggle (Out_Message);
end loop;
end Producer_B;
nblk1=4
nid=0
hdr6=8
[0x00] rec0=24 rec1=00 rec2=01 rec3=030
[0x01] rec0=1d rec1=00 rec2=02 rec3=038
[0x02] rec0=20 rec1=00 rec2=03 rec3=042
[0x03] rec0=14 rec1=00 rec2=04 rec3=000
tail 0x2151c7de4838d4473cc96 0x42a00088462060003