|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Sub_Contrat, seg_054dc1
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
package body Sub_Contrat is
function Is_Publication (Mess : in Message.Tmessage) return Boolean is
C : Message.Command_Type := Message.Publication;
Co : Message.Command_Type;
begin
Message.Unfill_Command (Mess, Co);
if Message.Command_Type'Image (Co) = Message.Command_Type'Image (C) then
return True;
else
return False;
end if;
end Is_Publication;
function Is_Unpublication (Mess : in Message.Tmessage) return Boolean is
C : Message.Command_Type := Message.Unpublication;
Co : Message.Command_Type;
begin
Message.Unfill_Command (Mess, Co);
if Message.Command_Type'Image (Co) = Message.Command_Type'Image (C) then
return True;
else
return False;
end if;
end Is_Unpublication;
procedure Fill_Contrat (Mess : in Message.Tmessage;
Contrat : out Tcontrat) is
Content_T : Message.Content_String;
Origin_N : Identification.Tclient_Id;
begin
Message.Unfill_Content (Mess, Content_T);
Contrat.Nom_Contrat := Content_T;
Message.Unfill_Origin (Mess, Origin_N);
Contrat.Id := Origin_N;
end Fill_Contrat;
procedure Add_Contrat (List_Of_Contrats : in out Contrat_List.List;
Contrat : in Tcontrat) is
begin
List_Of_Contrats := Contrat_List.Make (Contrat, List_Of_Contrats);
end Add_Contrat;
procedure Remove_Contrat (List_Of_Contrats : in out Contrat_List.List;
Nom : in Tnom_Contrat) is
Lbis : Contrat_List.List;
Iter : Contrat_List.Iterator;
begin
Contrat_List.Init (Iter, List_Of_Contrats);
while not Contrat_List.Done (Iter) loop
if Bounded_String.Image (Contrat_List.Value (Iter).Nom_Contrat) /=
Bounded_String.Image (Nom) then
Lbis := Contrat_List.Make (Contrat_List.Value (Iter), Lbis);
end if;
Contrat_List.Next (Iter);
end loop;
List_Of_Contrats := Lbis;
Contrat_List.Free (Lbis);
end Remove_Contrat;
function Contrat_Exists
(List_Of_Contrats : Contrat_List.List; Nom : in Tnom_Contrat)
return Boolean is
Iter : Contrat_List.Iterator;
begin
Contrat_List.Init (Iter, List_Of_Contrats);
while not Contrat_List.Done (Iter) loop
exit when Bounded_String.Image
(Contrat_List.Value (Iter).Nom_Contrat) =
Bounded_String.Image (Nom);
Contrat_List.Next (Iter);
end loop;
if not Contrat_List.Done (Iter) then
return True;
else
return False;
end if;
end Contrat_Exists;
function Contrat_Provider
(List_Of_Contrats : Contrat_List.List; Nom : in Tnom_Contrat)
return Identification.Tclient_Id is
Iter : Contrat_List.Iterator;
begin
Contrat_List.Init (Iter, List_Of_Contrats);
while Bounded_String.Image (Contrat_List.Value (Iter).Nom_Contrat) /=
Bounded_String.Image (Nom) loop
Contrat_List.Next (Iter);
end loop;
return Contrat_List.Value (Iter).Id;
end Contrat_Provider;
function Is_Subscription (Mess : in Message.Tmessage) return Boolean is
C : Message.Command_Type := Message.Subscription;
Co : Message.Command_Type;
begin
Message.Unfill_Command (Mess, Co);
if Message.Command_Type'Image (Co) = Message.Command_Type'Image (C) then
return True;
else
return False;
end if;
end Is_Subscription;
function Is_Unsubscription (Mess : in Message.Tmessage) return Boolean is
C : Message.Command_Type := Message.Unsubscription;
Co : Message.Command_Type;
begin
Message.Unfill_Command (Mess, Co);
if Message.Command_Type'Image (Co) = Message.Command_Type'Image (C) then
return True;
else
return False;
end if;
end Is_Unsubscription;
procedure Fill_Sub (Mess : in Message.Tmessage; Sub : out Tsubscription) is
Content_T : Message.Content_String;
Origin_N : Identification.Tclient_Id;
To_Tmp : Integer;
Ok : Boolean;
begin
Message.Unfill_Content (Mess, Content_T);
String_Utilities.String_To_Number
(Bounded_String.Image (Content_T), To_Tmp, Ok);
Sub.To := Identification.Tclient_Id (To_Tmp);
Message.Unfill_Origin (Mess, Origin_N);
Sub.Who := Origin_N;
end Fill_Sub;
procedure Add_Sub (List_Of_Sub : in out Sub_List.List;
Sub : in Tsubscription) is
begin
List_Of_Sub := Sub_List.Make (Sub, List_Of_Sub);
end Add_Sub;
procedure Remove_Sub (List_Of_Sub : in out Sub_List.List;
Who : in Identification.Tclient_Id) is
Lbis : Sub_List.List;
Iter : Sub_List.Iterator;
begin
Sub_List.Init (Iter, List_Of_Sub);
while not Sub_List.Done (Iter) loop
if Identification.Tclient_Id'Image (Sub_List.Value (Iter).Who) /=
Identification.Tclient_Id'Image (Who) then
Lbis := Sub_List.Make (Sub_List.Value (Iter), Lbis);
end if;
Sub_List.Next (Iter);
end loop;
List_Of_Sub := Lbis;
Sub_List.Free (Lbis);
end Remove_Sub;
function Subscription_Exists
(List_Of_Sub : Sub_List.List; To : in Identification.Tclient_Id)
return Boolean is
Iter : Sub_List.Iterator;
begin
Sub_List.Init (Iter, List_Of_Sub);
while not Sub_List.Done (Iter) loop
exit when Identification.Tclient_Id'Image
(Sub_List.Value (Iter).To) =
Identification.Tclient_Id'Image (To);
Sub_List.Next (Iter);
end loop;
if not Sub_List.Done (Iter) then
return True;
else
return False;
end if;
end Subscription_Exists;
function Subscripter (List_Of_Sub : Sub_List.List;
To : in Identification.Tclient_Id)
return Identification.Tclient_Id is
Iter : Sub_List.Iterator;
begin
Sub_List.Init (Iter, List_Of_Sub);
while Identification.Tclient_Id'Image (Sub_List.Value (Iter).To) /=
Identification.Tclient_Id'Image (To) loop
Sub_List.Next (Iter);
end loop;
return Sub_List.Value (Iter).Who;
end Subscripter;
end Sub_Contrat;
nblk1=a
nid=7
hdr6=10
[0x00] rec0=20 rec1=00 rec2=01 rec3=060
[0x01] rec0=19 rec1=00 rec2=05 rec3=04c
[0x02] rec0=1e rec1=00 rec2=04 rec3=01e
[0x03] rec0=1b rec1=00 rec2=09 rec3=008
[0x04] rec0=1c rec1=00 rec2=08 rec3=048
[0x05] rec0=1b rec1=00 rec2=06 rec3=032
[0x06] rec0=1b rec1=00 rec2=0a rec3=01a
[0x07] rec0=01 rec1=00 rec2=02 rec3=001
[0x08] rec0=bc rec1=32 rec2=80 rec3=007
[0x09] rec0=dd rec1=0f rec2=56 rec3=645
tail 0x2154d1dd687b9648c6736 0x42a00088462060003
Free Block Chain:
0x7: 0000 00 03 03 fc 80 37 4f 66 5f 43 6f 6e 74 72 61 74 ┆ 7Of_Contrat┆
0x3: 0000 00 00 00 18 80 15 66 69 63 61 74 69 6f 6e 2e 54 ┆ fication.T┆