DataMuseum.dk

top - download

    Length: 4191 (0x105f)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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;