|
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_02ca89
└─⟦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 Mailbox is
entry Wait_For_Reply (Message : out Standard.Message.Object;
Time_Out : Duration;
Expired : out Boolean);
entry Wait_For_Reply (M : Message.Object);
end Mailbox;
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
select --
Mailbox.Wait_For_Reply --
(Mes); -- We look if the actor is waiting
else -- for a message
null; --
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 Mailbox is
begin
loop
accept Wait_For_Reply (Message : out Standard.Message.Object;
Time_Out : Duration;
Expired : out Boolean) do
select
accept Wait_For_Reply (M : Standard.Message.Object) do
Message := M;
Expired := False;
end Wait_For_Reply;
or
delay Time_Out;
Expired := True;
end select;
end Wait_For_Reply;
end loop;
end Mailbox;
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
Mailbox.Wait_For_Reply
(Message => Message, Time_Out => Time_Out, Expired => Expired);
end Wait_For_Reply;
package body Core is
procedure Start is
begin
Rx.Start;
Hand_Shake.Wait_To_Transmit;
Actor;
end Start;
end Core;
end Agent;
nblk1=a
nid=4
hdr6=c
[0x00] rec0=2f rec1=00 rec2=01 rec3=02c
[0x01] rec0=1d rec1=00 rec2=02 rec3=02e
[0x02] rec0=01 rec1=00 rec2=05 rec3=002
[0x03] rec0=25 rec1=00 rec2=09 rec3=024
[0x04] rec0=28 rec1=00 rec2=07 rec3=022
[0x05] rec0=15 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 0x2152518ae84084ba7e108 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 03 03 fc 80 07 20 20 62 65 67 69 6e 07 00 27 ┆ begin '┆
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┆