|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 29696 (0x7400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Object_Manager, seg_05711b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Method;
with Byte_Defs;
with Bounded_String;
with Liste_Parametre;
with Transport_Defs;
with My_Channel_User;
with Bls_Constant;
with Registrated_Object;
with Utils;
with Task_Io;
package body Object_Manager is
function Null_Id return Object_Id is
begin
return Object_Id (Parametre_Defs.Unknown_Object);
end Null_Id;
function Is_Equal (Left, Right : Object_Id) return Boolean is
begin
return Byte_Defs."=" (Byte_Defs.Byte_String
(Parametre_Defs.Identificator (Left)),
Byte_Defs.Byte_String
(Parametre_Defs.Identificator (Right)));
end Is_Equal;
function Get_Socket (Id : Parametre_Defs.Identificator)
return Transport_Defs.Socket_Id is
begin
return Transport_Defs.Socket_Id
(Id (1 .. Bls_Constant.Size_Of_Our_Socket_Id));
end Get_Socket;
function Get_Host (Id : Parametre_Defs.Identificator)
return Transport_Defs.Host_Id is
begin
return Transport_Defs.Host_Id
(Id (Bls_Constant.Size_Of_Our_Socket_Id + 1 ..
Bls_Constant.Size_Of_Our_Socket_Id +
Bls_Constant.Size_Of_Address));
end Get_Host;
function Image (D_B : Object) return String is
Iter : Registrated_Objects.S_Iterator;
The_Value : Bounded_String.Variable_String (1024);
begin
begin
if not Registrated_Objects.Is_Empty
(Registrated_Objects.S_List (D_B.List)) then
Registrated_Objects.Init
(Iter, Registrated_Objects.S_List (D_B.List));
while not (Registrated_Objects.Done (Iter)) loop
Bounded_String.Append
(The_Value, Registrated_Object.Image
(Registrated_Objects.Value (Iter)));
Bounded_String.Append (The_Value,
Parametre_Defs.Message_Separator);
Bounded_String.Append (The_Value, Ascii.Lf);
Bounded_String.Append (The_Value, Ascii.Cr);
Registrated_Objects.Next (Iter);
end loop;
end if;
return Bounded_String.Image (The_Value);
end;
exception
when Constraint_Error =>
Task_Io.Put_Line
("object_manager.image =>size of bounded string to short");
end Image;
function Get_Object_By_Id (The_Orb : Object;
Id : Parametre_Defs.Identificator)
return Registrated_Object.Object is
Iter : Registrated_Objects.S_Iterator;
The_Value : Parametre.Variable_String;
An_Object : Registrated_Object.Object;
begin
if not Registrated_Objects.Is_Empty
(Registrated_Objects.S_List (The_Orb.List)) then
Registrated_Objects.Init
(Iter, Registrated_Objects.S_List (The_Orb.List));
while not (Registrated_Objects.Done (Iter)) loop
An_Object := Registrated_Objects.Value (Iter);
if Byte_Defs."=" (Byte_Defs.Byte_String
(Registrated_Object.Get_Id (An_Object)),
Byte_Defs.Byte_String (Id)) then
return An_Object;
end if;
Registrated_Objects.Next (Iter);
end loop;
return Registrated_Object.Null_Object;
end if;
end Get_Object_By_Id;
function Search_Object_Doing_Method
(Data_Base : Object;
Class : Parametre.Variable_String;
Method : Parametre.Variable_String) return Objects_Id.S_List is
Iter : Registrated_Objects.S_Iterator;
Id_List : Objects_Id.S_List;
The_Value : Parametre.Variable_String;
An_Object : Registrated_Object.Object;
begin
Id_List := Objects_Id.Nil;
if not Registrated_Objects.Is_Empty
(Registrated_Objects.S_List (Data_Base.List)) then
Registrated_Objects.Init
(Iter, Registrated_Objects.S_List (Data_Base.List));
while not (Registrated_Objects.Done (Iter)) loop
An_Object := Registrated_Objects.Value (Iter);
if Bounded_String.Image
(Registrated_Object.Get_Class (An_Object)) =
Bounded_String.Image (Class) and
Registrated_Object.Is_Method (An_Object, Method) then
Id_List :=
Objects_Id.Make
(Object_Id (Registrated_Object.Get_Id (An_Object)),
Id_List);
end if;
Registrated_Objects.Next (Iter);
end loop;
return Id_List;
end if;
end Search_Object_Doing_Method;
function Search_Method_By_Object_Id
(Data_Base : Object;
Object : Parametre_Defs.Identificator;
Method : Parametre.Variable_String) return Object_Id is
Iter : Registrated_Objects.S_Iterator;
The_Value : Parametre.Variable_String;
An_Object : Registrated_Object.Object;
begin
if not Registrated_Objects.Is_Empty
(Registrated_Objects.S_List (Data_Base.List)) then
Registrated_Objects.Init
(Iter, Registrated_Objects.S_List (Data_Base.List));
while not (Registrated_Objects.Done (Iter)) loop
An_Object := Registrated_Objects.Value (Iter);
if (Byte_Defs."=" (Byte_Defs.Byte_String
(Registrated_Object.Get_Id (An_Object)),
Byte_Defs.Byte_String (Object)) and
Registrated_Object.Is_Method (An_Object, Method)) then
return Object_Id ((Registrated_Object.Get_Id (An_Object)));
end if;
Registrated_Objects.Next (Iter);
end loop;
end if;
return Object_Id (Parametre_Defs.Orb);
end Search_Method_By_Object_Id;
procedure Add_Object (D_B : in out Object;
Id : out Object_Id;
In_Mess : Message.Object;
Out_Mess : in out Message.Object) is
Containt : Liste_Parametre.List;
Iter : Liste_Parametre.Iterator;
New_Object : Registrated_Object.Object;
Class : Parametre.Variable_String;
Socket : Transport_Defs.Socket_Id
(1 .. Bls_Constant.Size_Of_Our_Socket_Id);
Host : Transport_Defs.Host_Id (1 .. Bls_Constant.Size_Of_Address);
The_User_Channel : My_Channel_User.Object;
New_Dest : Parametre_Defs.Identificator;
Result : Boolean;
begin
Containt := Message.Get_Containt (In_Mess);
Liste_Parametre.Init (Iter, Containt);
Class := Liste_Parametre.Value (Iter);
Socket := Get_Socket (Message.Get_Emet (In_Mess));
Host := Get_Host (Message.Get_Emet (In_Mess));
Registrated_Object.Init (New_Object, Class, Socket, Host, Result);
New_Dest := Registrated_Object.Get_Id (New_Object);
Message.Create (O => Out_Mess,
Emet => Parametre_Defs.Orb,
Dest => New_Dest,
Typed => Message.Get_Type (In_Mess),
Number => Message.Get_Number (In_Mess),
Content => Liste_Parametre.Nil);
Id := Object_Id (New_Dest);
D_B.List := (Registrated_Objects.Make (New_Object, (D_B.List)));
end Add_Object;
procedure Talk_To_Object (Data_Base : Object;
Id : Object_Id;
Mess : in out Message.Object;
Result : out Boolean) is
The_Object : Registrated_Object.Object;
The_User_Channel : My_Channel_User.Object;
Nobody_Msg : Parametre_Defs.Identificator;
begin
The_Object := Get_Object_By_Id
(The_Orb => Data_Base,
Id => Parametre_Defs.Identificator (Id));
The_User_Channel := Registrated_Object.Get_Channel (The_Object);
Message.Send (Mess, The_User_Channel);
Nobody_Msg := Parametre_Defs.Identificator
(Utils.String_To_Byte_String
(My_Channel_User.Error_Msg
(1 .. Bls_Constant.Size_Of_Our_Socket_Id +
Bls_Constant.Size_Of_Address)));
if Is_Equal (Object_Id (Message.Get_Emet (Mess)),
Object_Id (Nobody_Msg)) then
Result := False;
else
Result := True;
end if;
end Talk_To_Object;
procedure Set_To_Free (D_B : in out Object; Id : Object_Id) is
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
begin
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
The_Object_Copy :=
Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
Registrated_Object.Ready_For_Work (The_Object);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
end Set_To_Free;
function Is_Unknown (D_B : Object; Id : Object_Id) return Boolean is
The_Object : Registrated_Object.Object;
begin
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
return Registrated_Object.Is_Unknown (O => The_Object);
end Is_Unknown;
procedure Set_To_Unknow (D_B : in out Object; Id : Object_Id) is
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
begin
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
The_Object_Copy :=
Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
Registrated_Object.Set_To_Unknown (The_Object);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
end Set_To_Unknow;
procedure Give_Work (D_B : in out Object; Id : Object_Id) is
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
begin
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
The_Object_Copy :=
Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
Registrated_Object.Give_Work (The_Object);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
end Give_Work;
procedure Work_Finished (D_B : in out Object; Id : Object_Id) is
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
begin
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
The_Object_Copy :=
Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
Registrated_Object.Work_Finished (The_Object);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
end Work_Finished;
procedure Remove_Object (D_B : in out Object; Id : in Object_Id) is
The_Object, The_Object_Copy : Registrated_Object.Object;
begin
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
The_Object_Copy :=
Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
Registrated_Object.Close_Channel (The_Object);
Registrated_Objects.Remove (X => The_Object_Copy, L => D_B.List);
end Remove_Object;
procedure Add_Method
(D_B : in out Object; Id : Object_Id; Mess : Message.Object) is
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
Param_Iter : Liste_Parametre.Iterator;
In_Parameters, Out_Parameters : Liste_Parametre.List;
Containt : Liste_Parametre.List;
Class, Method_N, Nb_Param : Parametre.Variable_String;
The_Method : Method.Object;
begin Containt := Message.Get_Containt (Mess);
Liste_Parametre.Init (Param_Iter, Containt);
Class := Liste_Parametre.Value (Param_Iter);
Liste_Parametre.Next (Param_Iter);
Method_N := Liste_Parametre.Value (Param_Iter);
Liste_Parametre.Next (Param_Iter);
Nb_Param := Liste_Parametre.Value (Param_Iter);
Liste_Parametre.Next (Param_Iter);
for I in 1 .. Integer'Value (Bounded_String.Image (Nb_Param)) loop
In_Parameters :=
Liste_Parametre.Make
(Liste_Parametre.Value (Param_Iter), In_Parameters);
Liste_Parametre.Next (Param_Iter);
end loop;
Nb_Param := Liste_Parametre.Value (Param_Iter);
Liste_Parametre.Next (Param_Iter);
for I in 1 .. Integer'Value (Bounded_String.Image (Nb_Param)) loop
Out_Parameters :=
Liste_Parametre.Make
(Liste_Parametre.Value (Param_Iter), Out_Parameters);
Liste_Parametre.Next (Param_Iter);
end loop;
Method.Init (O => The_Method,
Name => Method_N,
In_Parameters => In_Parameters,
Out_Parameters => Out_Parameters);
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
The_Object_Copy :=
Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
if Registrated_Object.Is_Unknown (The_Object) then
Registrated_Object.Ready_For_Work (The_Object);
end if;
Registrated_Object.Add_Method (O => The_Object, Meth => The_Method);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
end Add_Method;
procedure Remove_Method
(D_B : in out Object; Id : Object_Id; Mess : Message.Object) is
Param_Iter : Liste_Parametre.Iterator;
Containt : Liste_Parametre.List;
Class, Method_N : Parametre.Variable_String;
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
begin
Containt := Message.Get_Containt (Mess);
Liste_Parametre.Init (Param_Iter, Containt);
Class := Liste_Parametre.Value (Param_Iter);
Liste_Parametre.Next (Param_Iter);
Method_N := Liste_Parametre.Value (Param_Iter);
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
The_Object_Copy :=
Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator (Id));
Registrated_Object.Remove_Method (O => The_Object, Meth => Method_N);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
end Remove_Method;
procedure Subscribe (D_B : in out Object;
Subscripter_Id, Subscripted_Id : Object_Id;
Mess : Message.Object) is
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
Param_Iter : Liste_Parametre.Iterator;
Containt : Liste_Parametre.List;
Class, Method_N : Parametre.Variable_String;
The_Method, The_Method_Copy : Method.Object;
begin
Containt := Message.Get_Containt (Mess);
Liste_Parametre.Init (Param_Iter, Containt);
Class := Liste_Parametre.Value (Param_Iter);
Liste_Parametre.Next (Param_Iter);
Method_N := Liste_Parametre.Value (Param_Iter);
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Subscripted_Id));
The_Object_Copy := Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator
(Subscripted_Id));
Task_Io.Put_Line ("the object to subscribe is" &
Registrated_Object.Image (The_Object));
if (Registrated_Object.Is_Method (The_Object, Method_N)) then
The_Method := Registrated_Object.Get_Method
(O => The_Object, Meth => Method_N);
The_Method_Copy := Registrated_Object.Get_Method
(O => The_Object, Meth => Method_N);
Method.Add_Subscripted_Object
(O => The_Method,
The_Object => Parametre_Defs.Identificator (Subscripter_Id));
Registrated_Object.Replace_Method
(The_Object, The_Method_Copy, The_Method);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
else
Task_Io.Put_Line
("do not found the specified method in any object");
end if;
end Subscribe;
procedure Unsubscribe (D_B : in out Object;
Subscripter_Id, Subscripted_Id : Object_Id;
Mess : Message.Object) is
The_Object : Registrated_Object.Object;
The_Object_Copy : Registrated_Object.Object;
Param_Iter : Liste_Parametre.Iterator;
Containt : Liste_Parametre.List;
Class, Method_N : Parametre.Variable_String;
The_Method : Method.Object;
begin
Containt := Message.Get_Containt (Mess);
Liste_Parametre.Init (Param_Iter, Containt);
Class := Liste_Parametre.Value (Param_Iter);
Liste_Parametre.Next (Param_Iter);
Method_N := Liste_Parametre.Value (Param_Iter);
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Subscripted_Id));
The_Object_Copy := Get_Object_By_Id (The_Orb => D_B,
Id => Parametre_Defs.Identificator
(Subscripted_Id));
The_Method := Registrated_Object.Get_Method
(O => The_Object, Meth => Method_N);
Method.Remove_Subscripted_Object
(O => The_Method,
The_Object => Parametre_Defs.Identificator (Subscripted_Id));
Registrated_Object.Remove_Method (The_Object, Method_N);
Registrated_Object.Add_Method (The_Object, The_Method);
Registrated_Objects.Put_First (X => The_Object_Copy, L => D_B.List);
Registrated_Objects.Set_First (L => D_B.List, To_Be => The_Object);
end Unsubscribe;
function Get_All_Subscripter (D_B : in Object;
Subscripted : Object_Id;
Method_N : Parametre.Variable_String)
return Objects_Id.S_List is
The_Object : Registrated_Object.Object;
The_Method : Method.Object;
Id_List : Objects_Id.S_List;
Subter_List : Method.Sub_List.S_List;
Sub_Iter : Method.Sub_List.S_Iterator;
begin
The_Object := Get_Object_By_Id
(The_Orb => D_B,
Id => Parametre_Defs.Identificator (Subscripted));
The_Method := Registrated_Object.Get_Method
(O => The_Object, Meth => Method_N);
Subter_List := Method.Get_Sub_List (The_Method);
if not Method.Sub_List.Is_Empty (Subter_List) then
Method.Sub_List.Init (Iter => Sub_Iter, L => Subter_List);
Id_List := Objects_Id.Nil;
while not Method.Sub_List.Done (Sub_Iter) loop
Task_Io.Put_Line
("found " & Utils.Byte_String_To_String
(Byte_Defs.Byte_String
(Parametre_Defs.Identificator
(Method.Sub_List.Value (Sub_Iter)))));
Id_List :=
Objects_Id.Make
(Object_Id (Parametre_Defs.Identificator
(Method.Sub_List.Value (Sub_Iter))),
Id_List);
Method.Sub_List.Next (Sub_Iter);
exit when Method.Sub_List.Done (Sub_Iter);
end loop;
end if;
return Id_List;
end Get_All_Subscripter;
end Object_Manager;
nblk1=1c
nid=0
hdr6=38
[0x00] rec0=1d rec1=00 rec2=01 rec3=060
[0x01] rec0=18 rec1=00 rec2=08 rec3=05c
[0x02] rec0=19 rec1=00 rec2=10 rec3=004
[0x03] rec0=06 rec1=00 rec2=17 rec3=00a
[0x04] rec0=19 rec1=00 rec2=09 rec3=00e
[0x05] rec0=18 rec1=00 rec2=0b rec3=028
[0x06] rec0=17 rec1=00 rec2=0d rec3=08c
[0x07] rec0=18 rec1=00 rec2=0a rec3=00a
[0x08] rec0=16 rec1=00 rec2=18 rec3=00a
[0x09] rec0=12 rec1=00 rec2=07 rec3=030
[0x0a] rec0=0a rec1=00 rec2=1c rec3=008
[0x0b] rec0=18 rec1=00 rec2=0c rec3=024
[0x0c] rec0=01 rec1=00 rec2=1b rec3=062
[0x0d] rec0=1a rec1=00 rec2=05 rec3=02e
[0x0e] rec0=18 rec1=00 rec2=0e rec3=056
[0x0f] rec0=19 rec1=00 rec2=06 rec3=074
[0x10] rec0=06 rec1=00 rec2=04 rec3=002
[0x11] rec0=14 rec1=00 rec2=02 rec3=082
[0x12] rec0=1a rec1=00 rec2=11 rec3=030
[0x13] rec0=16 rec1=00 rec2=1a rec3=014
[0x14] rec0=19 rec1=00 rec2=19 rec3=03a
[0x15] rec0=10 rec1=00 rec2=15 rec3=03c
[0x16] rec0=18 rec1=00 rec2=16 rec3=022
[0x17] rec0=05 rec1=00 rec2=14 rec3=024
[0x18] rec0=14 rec1=00 rec2=03 rec3=056
[0x19] rec0=0e rec1=00 rec2=13 rec3=01a
[0x1a] rec0=14 rec1=00 rec2=0f rec3=000
[0x1b] rec0=06 rec1=00 rec2=12 rec3=000
tail 0x21763bd7487c59b5cbd2f 0x42a00088462060003