|
|
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 - metrics - downloadIndex: B T
Length: 3687 (0xe67)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─⟦124ff5788⟧ »DATA«
└─⟦this⟧
with Behavior_Defs;
with Behavior_Exception;
with Identifier;
with Message;
with Message_Transport;
with Method;
with Parameter;
with Signature;
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;
procedure Process_Message (M : String) is
Mes : Message.Object := Message.Value (M);
Handled : Boolean;
begin
Process_Message (Mes, Handled);
if not Handled then -- The message is unknown
select --
Tx.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);
return Registered;
end Identified_Generic;
function Identified is new Identified_Generic (Behavior_Defs.Identify);
procedure Ready_To_Receive is
begin
Publish (Self => Get_Identity);
end Ready_To_Receive;
procedure Transport_Start is
new Message_Transport.Start_Server
(Register_Service => Behavior_Defs.Register_Service,
Service_Identified => Identified,
Ready_To_Receive => 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
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;
end Wait_For_Reply;
or
delay Time_Out;
Expired := True;
end select;
end Wait_For_Reply;
end loop;
end Tx;
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
Tx.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;
end Start;
end Core;
end Agent;