|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package body Agent, package body Core, seg_02c8bd
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Behavior_Defs;
with Behavior_Exception;
with Identifier;
with Message;
with Message_Transport;
with Method;
with Parameter;
with Signature;
with Text_Io;
use Text_Io;
package body Agent is
This : Identifier.Object; -- set once the behavior has been identified
Registered : Boolean := False;
task Rx is
entry Start;
pragma Os_Task (0); --[to get non blocking socket reads]
end Rx;
task Tx is
entry Wait_For_Reply (Message : out Standard.Message.Object;
Time_Out : Duration;
Expired : out Boolean);
entry Wait_For_Reply (M : Message.Object);
end Tx;
task Hand_Shake is
entry Ready_To_Receive;
entry Wait_To_Transmit;
end Hand_Shake;
procedure Process_Message (M : String) is
Mes : Message.Object := Message.Value (M);
Handled : Boolean;
begin
Process_Message (Mes, Handled);
Put_Line ("process message: we received => " & M);
if not Handled then -- The message is unknown
Put_Line ("process message: not handled");
select --
Tx.Wait_For_Reply (Mes); -- We look if the actor is waiting
Put_Line ("process message: message handed over to actor");
else -- for a message
null; --
Put_Line ("process message: actor was not waiting");
end select; --
end if;
end Process_Message;
generic
with procedure Identify (M : String;
Behavior : out Identifier.Object;
Registered : out Boolean);
function Identified_Generic (M : String) return Boolean;
function Identified_Generic (M : String) return Boolean is
begin
Identify (M => M, Behavior => This, Registered => Registered);
Put_Line ("identify: registered => " & Boolean'Image (Registered));
return Registered;
end Identified_Generic;
function Identified is new Identified_Generic (Behavior_Defs.Identify);
procedure Transport_Start is
new Message_Transport.Start_Server
(Register_Service => Behavior_Defs.Register_Service,
Service_Identified => Identified,
Ready_To_Receive => Hand_Shake.Ready_To_Receive,
Receive_Callback => Process_Message);
task body Rx is
begin
accept Start;
Transport_Start (Local_Socket => 0, Buffer_Size => 1024);
--
-- when Local_Socket is 0 the transport layer will invent one
end Rx;
task body Tx is
begin
loop
Put_Line ("tx: we are waiting the actor");
accept Wait_For_Reply (Message : out Standard.Message.Object;
Time_Out : Duration;
Expired : out Boolean) do
Put_Line ("tx: we are waiting the server");
select
accept Wait_For_Reply (M : Standard.Message.Object) do
Message := M;
Expired := False;
Put_Line ("tx: we received a message");
end Wait_For_Reply;
or
delay Time_Out;
Expired := True;
Put_Line ("time out has expired");
end select;
end Wait_For_Reply;
Put_Line ("tx: we are done");
end loop;
end Tx;
task body Hand_Shake is
begin
accept Ready_To_Receive do
Publish (Self => Get_Identity);
end Ready_To_Receive;
accept Wait_To_Transmit;
end Hand_Shake;
function Get_Identity return Identifier.Object is
begin
if not Registered then
raise Behavior_Exception.Not_Yet_Registered_Error;
end if;
return This;
end Get_Identity;
procedure Wait_For_Reply (Message : out Standard.Message.Object;
Time_Out : Duration;
Expired : out Boolean) is
begin
Put_Line ("wait_for_reply: we rendez vous with tx");
Tx.Wait_For_Reply (Message => Message,
Time_Out => Time_Out,
Expired => Expired);
Put_Line ("wait_for_reply: rendez vous with tx is done");
end Wait_For_Reply;
package body Core is
procedure Start is
begin
Put_Line ("start: ");
Rx.Start;
Put_Line ("start: rx.started");
Hand_Shake.Wait_To_Transmit;
Put_Line ("start: we can transmit");
Actor;
end Start;
end Core;
end Agent;
nblk1=a
nid=9
hdr6=c
[0x00] rec0=2d rec1=00 rec2=01 rec3=012
[0x01] rec0=1b rec1=00 rec2=02 rec3=042
[0x02] rec0=25 rec1=00 rec2=05 rec3=062
[0x03] rec0=1e rec1=00 rec2=07 rec3=018
[0x04] rec0=09 rec1=00 rec2=04 rec3=032
[0x05] rec0=26 rec1=00 rec2=0a rec3=000
[0x06] rec0=16 rec1=00 rec2=02 rec3=000
[0x07] rec0=14 rec1=00 rec2=07 rec3=000
[0x08] rec0=14 rec1=00 rec2=07 rec3=000
[0x09] rec0=14 rec1=00 rec2=07 rec3=001
tail 0x21524ed7c840581c9cc4b 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 03 00 72 80 04 61 6b 65 3b 04 00 00 00 00 00 ┆ r ake; ┆
0x3: 0000 00 06 03 5c 80 4f 20 20 20 20 20 20 2d 2d 20 20 ┆ \ O -- ┆
0x6: 0000 00 08 03 fc 80 39 6f 6e 32 20 28 48 6f 73 74 20 ┆ 9on2 (Host ┆
0x8: 0000 00 00 03 fc 80 38 20 20 20 20 20 20 20 41 64 64 ┆ 8 Add┆