|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 6185 (0x1829)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
separate (Semantique)
package body Materiels is
Type_Courant : Standard_String.Object;
Action_Courante : Standard_String.Object;
Code_Courant : Integer;
Option_De_Courante : Lexical.Token := L_Unk;
Option_Vers_Courante : Lexical.Token := L_Unk;
Option_En_Courante : Lexical.Token := L_Unk;
Erreur_Type : Boolean := False;
Erreur_Action : Boolean := False;
Erreur_Code : Boolean := False;
procedure Ouvrir_Bloc_Materiel is
begin
Nombre_Actions := 0;
end Ouvrir_Bloc_Materiel;
procedure Fermer_Bloc_Materiel is
begin
null;
end Fermer_Bloc_Materiel;
function Type_Existe (Un_Type : Standard_String.Object) return Boolean is
begin
for I in 1 .. (Nombre_Actions) loop
if Standard_String.Equal (Tableau_Actions (I).Le_Type, Un_Type) then
return True;
end if;
end loop;
return False;
end Type_Existe;
procedure Nouveau_Type (Un_Type : Standard_String.Object) is
begin
Erreur_Type := False;
if Type_Existe (Un_Type) then
Erreurs.Ajouter ("Le type '" &
Standard_String.Get_Contents (Un_Type) &
"' existe deja.");
Erreur_Type := True;
else
Standard_String.Copy (From => Un_Type, To => Type_Courant);
end if;
end Nouveau_Type;
procedure Fin_Nouveau_Type is
begin
null;
end Fin_Nouveau_Type;
function Action_Existe
(Un_Type : Standard_String.Object;
Une_Action : Standard_String.Object) return Boolean is
begin
for I in 1 .. (Nombre_Actions) loop
if (Standard_String.Equal
(Tableau_Actions (I).Le_Type, Un_Type)) and then
(Standard_String.Equal
(Tableau_Actions (I).L_Action, Une_Action)) then
return True;
end if;
end loop;
return False;
end Action_Existe;
function Action_Existe (L_Action : Standard_String.Object) return Boolean is
begin
for I in 1 .. (Nombre_Actions) loop
if (Standard_String.Equal
(Tableau_Actions (I).L_Action, L_Action)) then
return True;
end if;
end loop;
return False;
end Action_Existe;
procedure Nouvelle_Action (Une_Action : Standard_String.Object) is
begin
if not (Erreur_Type) then
if Action_Existe (Type_Courant, Une_Action) then
Erreurs.Ajouter
("L'action '" & Standard_String.Get_Contents (Une_Action) &
"' existe deja pour le type '" &
Standard_String.Get_Contents (Type_Courant) & "'.");
Erreur_Action := True;
else
Standard_String.Copy (From => Une_Action,
To => Action_Courante);
end if;
end if;
end Nouvelle_Action;
procedure Donner_Code_Action (Un_Code : Integer) is
begin
if not Erreur_Type and then not Erreur_Action then
if Un_Code >= 0 and then Un_Code <= 999999 then
Code_Courant := Un_Code;
else
Erreurs.Ajouter
("Le code de l'action doit etre compris entre 00 et 999999");
Erreur_Code := True;
end if;
end if;
end Donner_Code_Action;
procedure Fin_Nouvelle_Action is
begin
if Nombre_Actions = Max then
Erreurs.Ajouter ("Nombre d'actions trop grand");
end if;
if (not Erreur_Type) and then
(not Erreur_Action) and then (not Erreur_Code) then
Nombre_Actions := Nombre_Actions + 1;
Standard_String.Copy
(From => Action_Courante,
To => Tableau_Actions (Nombre_Actions).L_Action);
Standard_String.Copy
(From => Type_Courant,
To => Tableau_Actions (Nombre_Actions).Le_Type);
Tableau_Actions (Nombre_Actions).Le_Code := Code_Courant;
Tableau_Actions (Nombre_Actions).De := Option_De_Courante;
Tableau_Actions (Nombre_Actions).Vers := Option_Vers_Courante;
Tableau_Actions (Nombre_Actions).En := Option_En_Courante;
end if;
Erreur_Action := False;
Erreur_Code := False;
end Fin_Nouvelle_Action;
procedure Ouvrir_Champ_Option is
begin
null;
end Ouvrir_Champ_Option;
procedure Option (Une_Option : Lexical.Token) is
begin
case Une_Option is
when L_De =>
Option_De_Courante := Lexical.L_Ok;
when L_Vers =>
Option_Vers_Courante := Lexical.L_Ok;
when L_En =>
Option_En_Courante := Lexical.L_Ok;
when others =>
null;
end case;
end Option;
procedure Fermer_Champ_Option is
begin
null;
end Fermer_Champ_Option;
procedure Imprimer_Materiel is
begin
for I in 1 .. Nombre_Actions loop
Text_Io.Put_Line ("Nom action : " &
Standard_String.Get_Contents
(Tableau_Actions (I).L_Action) &
" Type materiel : " &
(Standard_String.Get_Contents
(Tableau_Actions (I).Le_Type) &
" Code bitbus : " &
Integer'Image (Tableau_Actions (I).Le_Code)) &
" de : " & Lexical.Token'Image
(Tableau_Actions (I).De) &
" vers : " & Lexical.Token'Image
(Tableau_Actions (I).Vers) &
" en : " & Lexical.Token'Image
(Tableau_Actions (I).En));
end loop;
Text_Io.Put_Line ("");
Text_Io.Put_Line ("");
end Imprimer_Materiel;
end Materiels;