DataMuseum.dk

top - download

    Length: 3687 (0xe67)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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;