DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦c86eb1941⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Observer, seg_056cdc

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



with Constant_Start_End, All_String;
with Com_Defs, T_Message, T_Status;  
with Text_Manager;

package body Generic_Observer is

    My_Receive_Frame : My_Message.T_Frame;
    My_Send_Frame : My_Message.T_Frame;  
    My_Status : Boolean := False;
    Stop : Boolean := False;
    My_Appli_Number : Com_Defs.Com_Number;
    Orb_Appli_Number : constant Com_Defs.Com_Number := 0;
    My_Quest_Number : Com_Defs.Com_Number := 0;
    -- message qui ne recoit pas de reponse

    My_Data_To_Send : Com_Defs.V_String;

    My_Adress_String_And_Apply_Number :
       All_String.Adress_String_And_Apply_Number;
    My_Adress_String : All_String.Adress_String;
    My_Machine_Name, My_Adress_Ip : Com_Defs.V_String;
    Null_Data : Com_Defs.V_String := Com_Defs.Value ("");

    My_Integer_Type_Of_Message : Integer;
    My_Integer_Type_Of_Status : Integer;  
    My_Type_Of_Message : T_Message.T_Mess := T_Message.Response;
    My_Type_Of_Status : T_Status.T_State := T_Status.Observer_To_Orb;

    My_V_String_Data : Com_Defs.V_String;


    procedure Init is
    begin  
        My_Message.Init (My_Appli_Number, My_Machine_Name,
                         My_Adress_Ip, My_Status);  
        My_Message.Init_T_Frame (My_Send_Frame, My_Adress_Ip,
                                 My_Appli_Number, My_Quest_Number);
    end Init;


    procedure Observer_Treatment is
    begin

        Init;

-- REGISTRATION
        My_Message.Init_Data_Message (My_Machine_Name, My_Send_Frame);
        Text_Manager.Text.Put_Line ("OBSERVER has sent : " &
                                    My_Message.Image (My_Send_Frame));
        My_Message.Send (Orb_Appli_Number, Com_Defs.Orb_Name_Machine_V_String,
                         T_Message.Registration, My_Type_Of_Status,
                         My_Send_Frame, My_Status);

-- SUBSCRIPTION
        My_Message.Remove_Data (My_Send_Frame);
        My_V_String_Data := My_Message.Value (Contract);
        My_Message.Init_Data_Message (My_V_String_Data, My_Send_Frame);
        Text_Manager.Text.Put_Line ("OBSERVER has sent : " &
                                    My_Message.Image (My_Send_Frame));  
        My_Message.Send (Orb_Appli_Number, Com_Defs.Orb_Name_Machine_V_String,
                         T_Message.Subscription, My_Type_Of_Status,
                         My_Send_Frame, My_Status);

        loop

            loop
                delay (30.0);
                My_Message.Receive (My_Appli_Number,
                                    My_Receive_Frame, My_Status);
                Text_Manager.Text.Put_Line
                   ("OBSERVER : tests if something is arrived");
                exit when My_Status = True;  
            end loop;

            Stop := True;
-- on sortira de la boucle principale apres avoir recu un message
-- de maniere a simuler un Unsubscription et un Unregistration

            Text_Manager.Text.Put_Line ("OBSERVER has received : " &
                                        My_Message.Image (My_Receive_Frame));  
            My_Integer_Type_Of_Message :=
               My_Message.Read_Type_Of_Message (My_Receive_Frame);
            My_Message.Copy (My_Send_Frame, My_Receive_Frame);

            case My_Integer_Type_Of_Message is
                when T_Message.T_Mess'Pos (T_Message.Request_Service) =>  
                    begin
                        Text_Manager.Text.Put_Line
                           ("OBSERVER : has received the object to observe");
                    end;
                when others =>
                    Text_Manager.Text.Put_Line
                       ("OBSERVER : type of message is unknown");
            end case;

            My_Integer_Type_Of_Status :=
               My_Message.Read_Type_Of_Status (My_Receive_Frame);

            My_Integer_Type_Of_Status :=
               My_Message.Read_Type_Of_Status (My_Receive_Frame);

            case My_Integer_Type_Of_Status is
                when T_Status.T_State'Pos (T_Status.Orb_To_Observer) =>
                    begin
                        null;
                    end;  
                when others =>
                    Text_Manager.Text.Put_Line
                       ("OBSERVER : type of status is unknown");
            end case;

            exit when Stop;
        end loop;

        My_Message.Init_T_Frame (My_Send_Frame, My_Adress_Ip,
                                 My_Appli_Number, My_Quest_Number);

-- UNSUBSCRIPTION
        My_Message.Remove_Data (My_Send_Frame);
        My_V_String_Data := Com_Defs.Value (Contract);
        My_Message.Init_Data_Message (My_V_String_Data, My_Send_Frame);
        Text_Manager.Text.Put_Line ("OBSERVER has sent : " &
                                    My_Message.Image (My_Send_Frame));
        My_Message.Send (Orb_Appli_Number, Com_Defs.Orb_Name_Machine_V_String,
                         T_Message.Unsubscription, My_Type_Of_Status,
                         My_Send_Frame, My_Status);

-- UNREGISTRATION
        My_Message.Init_Data_Message (Null_Data, My_Send_Frame);
        My_Message.Remove_Data (My_Send_Frame);
        Text_Manager.Text.Put_Line ("OBSERVER has sent : " &
                                    My_Message.Image (My_Send_Frame));
        My_Message.Send (Orb_Appli_Number, Com_Defs.Orb_Name_Machine_V_String,
                         T_Message.Unregistration, My_Type_Of_Status,
                         My_Send_Frame, My_Status);

-- On desalloue notre numero d'application
        My_Message.Remove (My_Appli_Number);

    end Observer_Treatment;

end Generic_Observer;

E3 Meta Data

    nblk1=a
    nid=6
    hdr6=c
        [0x00] rec0=1c rec1=00 rec2=01 rec3=030
        [0x01] rec0=1d rec1=00 rec2=08 rec3=03e
        [0x02] rec0=17 rec1=00 rec2=09 rec3=034
        [0x03] rec0=15 rec1=00 rec2=0a rec3=07a
        [0x04] rec0=19 rec1=00 rec2=04 rec3=018
        [0x05] rec0=12 rec1=00 rec2=07 rec3=000
        [0x06] rec0=13 rec1=00 rec2=08 rec3=000
        [0x07] rec0=14 rec1=00 rec2=06 rec3=036
        [0x08] rec0=17 rec1=00 rec2=07 rec3=02a
        [0x09] rec0=0a rec1=00 rec2=08 rec3=001
    tail 0x217634e1c87c555acc2ca 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 03 02 cb 80 2b 5f 4d 65 73 73 61 67 65 2e 55  ┆     +_Message.U┆
  0x3: 0000  00 02 03 fc 80 1e 61 63 68 69 6e 65 5f 4e 61 6d  ┆      achine_Nam┆
  0x2: 0000  00 05 00 2b 80 28 20 20 20 20 20 20 4d 79 5f 4d  ┆   + (      My_M┆
  0x5: 0000  00 00 00 05 80 02 3d 20 02 28 4d 79 5f 52 65 63  ┆      =  (My_Rec┆