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

⟦927bb3f7d⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Registrated_Object, seg_054677, seg_054d6d

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 Task_Io;
with Utils;
with Text_Io;
with Transport_Defs;
with Bounded_String;
use Bounded_String;
package body Registrated_Object is
    function Image (O : in Object) return String is
        The_Value : Parametre.Variable_String;
    begin
        Append (The_Value, O.Class);
        Append (The_Value, Parametre_Defs.Message_Separator);
        Append (The_Value, String (Get_Id (O)));
        Append (The_Value, Parametre_Defs.Message_Separator);
        Append (The_Value, My_Channel_User.Image (O.Channel));
        Append (The_Value, Parametre_Defs.Message_Separator);

        Append (The_Value, Get_Methods (O));
        return Bounded_String.Image (The_Value);
    end Image;


    function Get_Id (O : in Object) return Parametre_Defs.Identificator is
    begin
        return Parametre_Defs.Identificator (My_Channel_User.Image (O.Channel));
    end Get_Id;


    function Get_Channel (O : in Object) return My_Channel_User.Object is
    begin
        return O.Channel;
    end Get_Channel;


    function Get_Class (O : in Object) return Parametre.Variable_String is
    begin
        return O.Class;
    end Get_Class;

    function Get_Methods (O : in Object) return Parametre.Variable_String is
        Iter : Method_List.S_Iterator;
        The_Value : Parametre.Variable_String;

    begin  
        if not Method_List.Is_Empty (O.Methods) then
            Method_List.Init (Iter, O.Methods);
            while not Method_List.Done (Iter) loop
                Append (The_Value, Method.Image (Method_List.Value (Iter)));
                Append (The_Value, Parametre_Defs.Message_Separator);
                Method_List.Next (Iter);  
            end loop;
        end if;
        return The_Value;
    end Get_Methods;

    function Get_Method (O : in Object; Meth : in Parametre.Variable_String)
                        return Method.Object is
        Iter : Method_List.S_Iterator;
        Temp : Method.Object;
    begin

        Method_List.Init (Iter, O.Methods);
        while not Method_List.Done (Iter) loop
            Temp := Method_List.Value (Iter);
            exit when Method.Get_Method_Name (Temp) = Meth;
            Method_List.Next (Iter);
        end loop;  
        return Temp;
    end Get_Method;


    function Is_Method (O : in Object; Meth : Parametre.Variable_String)
                       return Boolean is

        Iter : Method_List.S_Iterator;
        Temp : Method.Object;
    begin
        if not Method_List.Is_Empty (O.Methods) then
            Method_List.Init (Iter, O.Methods);
            loop
                Temp := Method_List.Value (Iter);
                Text_Io.Put_Line (Bounded_String.Image
                                     (Method.Get_Method_Name (Temp)) &
                                  "::::" & Bounded_String.Image (Meth));

                if Bounded_String.Image (Method.Get_Method_Name (Temp)) =
                   Bounded_String.Image (Meth) then
                    return True;
                end if;

                Method_List.Next (Iter);
                exit when Method_List.Done (Iter);
            end loop;  
        end if;
        return False;
    end Is_Method;


    function Get_State (O : in Object) return Registered_Object_State.Object is
    begin
        return O.State;
    end Get_State;


    procedure Add_Method (O : in out Object; Meth : Method.Object) is
    begin
        if not Method_List.Is_In (Meth, O.Methods) then
            O.Methods := Method_List.Make (Meth, O.Methods);
        end if;
    end Add_Method;


    procedure Remove_Method (O : in out Object;
                             Meth : Parametre.Variable_String) is
        Temp : Method.Object;
    begin
        if Is_Method (O, Meth) then
            Temp := Get_Method (O, Meth);
            Method_List.Remove (Temp, O.Methods);
        end if;
    end Remove_Method;


    procedure Free (O : in out Object) is
        Temp : Method.Object;
    begin
        while not Method_List.Is_Empty (O.Methods) loop
            Temp := Method_List.First (O.Methods);
            Method.Free (Temp);
            O.Methods := Method_List.Rest (O.Methods);
        end loop;
    end Free;


    procedure Init (O : in out Object;
                    Class : Parametre.Variable_String;
                    Obj_Sock : Parametre.Variable_String;
                    Obj_Host : Parametre.Variable_String;
                    Ok : out Boolean) is
        Channel_Ok : Boolean;
    begin
        O.Class := Class;  
        My_Channel_User.Init
           (O => O.Channel,
            S => Transport_Defs.Socket_Id
                    (Utils.String_To_Byte_String (Image (Obj_Sock))),
            H => Transport_Defs.Host_Id
                    (Utils.String_To_Byte_String (Image (Obj_Host))),
            Result => Channel_Ok);  
        if not Channel_Ok then
            Text_Io.Put_Line ("cannot open the users channel => " & Image (O));

        end if;  
        Registered_Object_State.Init (O.State);
        Ok := Channel_Ok;
    end Init;
    procedure Give_Work (O : in out Object) is

    begin
        if not Registered_Object_State.Is_Unknow (O.State) then
            Registered_Object_State.Inc (O.State);
        else
            Text_Io.Put_Line ("the work_dog is false (object_state)");
        end if;
    end Give_Work;
    procedure Work_Finished (O : in out Object) is

    begin
        if Registered_Object_State.Is_Busy (O.State) then
            Registered_Object_State.Dec (O.State);
        else
            Text_Io.Put_Line ("the object is not busy (object_state));");
        end if;
    end Work_Finished;  
    procedure Ready_For_Work (O : in out Object) is

    begin
        Registered_Object_State.Make_Free (O.State);
    end Ready_For_Work;

end Registrated_Object;

E3 Meta Data

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=1f rec1=00 rec2=01 rec3=006
        [0x01] rec0=1d rec1=00 rec2=02 rec3=00c
        [0x02] rec0=1b rec1=00 rec2=03 rec3=08a
        [0x03] rec0=22 rec1=00 rec2=04 rec3=00e
        [0x04] rec0=1d rec1=00 rec2=05 rec3=022
        [0x05] rec0=1e rec1=00 rec2=06 rec3=018
        [0x06] rec0=03 rec1=00 rec2=07 rec3=000
    tail 0x2175d7b4a87b8842f22bf 0x42a00088462060003