|
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 - metrics - download
Length: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Registrated_Object, seg_057109
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Bls_Constant;
with Byte_Defs;
with Utils;
with Transport_Defs;
with Parametre;
use Parametre;
with Parametre_Defs;
with Bounded_String;
use Bounded_String;
with Task_Io;
with Transport_Defs;
with Utils;
package body Registrated_Object is
function Null_Object return Object is
begin
return (My_Channel_User.Null_Channel, Parametre.Null_Variable_String,
Method_List.Nil, Registered_Object_State.Null_Object_State);
end Null_Object;
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 (Utils.Byte_String_To_String
(Byte_Defs.Byte_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));
Append (The_Value, Parametre_Defs.Message_Separator);
Append (The_Value, Registered_Object_State.Image (O.State));
return Bounded_String.Image (The_Value);
end Image;
function Get_Id (O : in Object) return Parametre_Defs.Identificator is
Id : Byte_Defs.Byte_String (1 .. Bls_Constant.Size_Of_Our_Socket_Id +
Bls_Constant.Size_Of_Address);
begin
Id (1 .. Bls_Constant.Size_Of_Our_Socket_Id) :=
Byte_Defs.Byte_String (My_Channel_User.Get_Socket_Id (O.Channel));
Id (Bls_Constant.Size_Of_Our_Socket_Id + 1 ..
Bls_Constant.Size_Of_Address +
Bls_Constant.Size_Of_Our_Socket_Id) :=
Byte_Defs.Byte_String (My_Channel_User.Get_Host_Id (O.Channel));
return Parametre_Defs.Identificator (Id);
end Get_Id;
procedure Close_Channel (O : in out Object) is
begin
My_Channel_User.Close (O.Channel);
end Close_Channel;
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);
Task_Io.Put_Line (Method.Image (Temp));
if (Bounded_String.Image (Method.Get_Method_Name (Temp))) =
String (Bounded_String.Image (Meth)) then
return Temp;
end if;
Method_List.Next (Iter);
end loop;
return Method.Null_Method;
end Get_Method;
procedure Replace_Method
(O : in out Object;
The_Method_To_Replace, New_Method : in out Method.Object) is
begin
Method_List.Put_First
(X => The_Method_To_Replace,
L => O.Methods);-- (O.Methods, The_Method_To_Replace);
Method_List.Set_First (L => O.Methods,
To_Be => New_Method);-- (O.Methods.New_Method);
end Replace_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);
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 Is_Free (O : Object) return Boolean is
begin
return Registered_Object_State.Is_Free (O.State);
end Is_Free;
function Is_Unknown (O : Object) return Boolean is
begin
return Registered_Object_State.Is_Unknow (O.State);
end Is_Unknown;
function Is_Busy (O : Object) return Boolean is
begin
return Registered_Object_State.Is_Busy (O.State);
end Is_Busy;
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 : Transport_Defs.Socket_Id;
Obj_Host : Transport_Defs.Host_Id;
Ok : out Boolean) is
Channel_Ok : Boolean;
begin
O.Class := Class;
My_Channel_User.Init (O => O.Channel,
S => Obj_Sock,
H => Obj_Host,
Result => Channel_Ok);
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
Task_Io.Put_Line
("the work_dog is false (object_state) =>you want to give work to an object which is in an unknown 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
Task_Io.Put_Line
("the object is not busy (object_state) => the work can not be finished");
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;
procedure Set_To_Unknown (O : in out Object) is
begin
Registered_Object_State.Init (O.State);
end Set_To_Unknown;
end Registrated_Object;
nblk1=b
nid=0
hdr6=16
[0x00] rec0=20 rec1=00 rec2=01 rec3=00c
[0x01] rec0=15 rec1=00 rec2=0b rec3=000
[0x02] rec0=0a rec1=00 rec2=06 rec3=020
[0x03] rec0=1e rec1=00 rec2=02 rec3=018
[0x04] rec0=19 rec1=00 rec2=03 rec3=06a
[0x05] rec0=0d rec1=00 rec2=0a rec3=018
[0x06] rec0=21 rec1=00 rec2=04 rec3=076
[0x07] rec0=03 rec1=00 rec2=05 rec3=028
[0x08] rec0=1d rec1=00 rec2=08 rec3=05e
[0x09] rec0=1d rec1=00 rec2=07 rec3=008
[0x0a] rec0=05 rec1=00 rec2=09 rec3=001
tail 0x21763bbde87c59ae9c10e 0x42a00088462060003