DataMuseum.dk

top - download

    Length: 4894 (0x131e)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦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 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;