|
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 Sub_Contrat, seg_055ea6
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io;
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
Text_Io.Put_Line (Bounded_String.Image
(Contrat_List.Value (Iter).Nom_Contrat));
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
Text_Io.Put_Line ("Je passe a vrai");
return True;
else
Text_Io.Put_Line ("Je passe a faux");
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 (L : in Contrat_List.List;
Mess : in Message.Tmessage;
Sub : out Tsubscription) is
Content_T : Message.Content_String;
Origin_N : Identification.Tclient_Id;
To_Tmp : Identification.Tclient_Id;
Ok : Boolean;
begin
Message.Unfill_Content (Mess, Content_T);
if Contrat_Exists (L, Content_T) then
-- String_Utilities.String_To_Number
-- (Bounded_String.Image (Content_T), To_Tmp, Ok);
To_Tmp := Contrat_Provider (L, Content_T);
end if;
Sub.To := 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=b
nid=b
hdr6=14
[0x00] rec0=22 rec1=00 rec2=01 rec3=03a
[0x01] rec0=00 rec1=00 rec2=07 rec3=026
[0x02] rec0=19 rec1=00 rec2=05 rec3=04c
[0x03] rec0=1a rec1=00 rec2=04 rec3=036
[0x04] rec0=1c rec1=00 rec2=03 rec3=058
[0x05] rec0=1d rec1=00 rec2=09 rec3=03c
[0x06] rec0=0d rec1=00 rec2=08 rec3=048
[0x07] rec0=1b rec1=00 rec2=06 rec3=032
[0x08] rec0=1b rec1=00 rec2=0a rec3=01a
[0x09] rec0=01 rec1=00 rec2=02 rec3=001
[0x0a] rec0=77 rec1=1c rec2=70 rec3=000
tail 0x21761621c87c09b36a54a 0x42a00088462060003
Free Block Chain:
0xb: 0000 00 00 00 1b 80 18 20 20 20 20 20 20 20 20 20 20 ┆ ┆