|
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: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Materiels, seg_039086, separate Semantique
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
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;
nblk1=9
nid=4
hdr6=10
[0x00] rec0=24 rec1=00 rec2=01 rec3=018
[0x01] rec0=1f rec1=00 rec2=06 rec3=058
[0x02] rec0=1c rec1=00 rec2=05 rec3=05c
[0x03] rec0=0c rec1=00 rec2=03 rec3=00c
[0x04] rec0=19 rec1=00 rec2=07 rec3=012
[0x05] rec0=00 rec1=00 rec2=09 rec3=006
[0x06] rec0=20 rec1=00 rec2=08 rec3=072
[0x07] rec0=12 rec1=00 rec2=02 rec3=000
[0x08] rec0=12 rec1=00 rec2=02 rec3=001
tail 0x21735f7c884e74c963be4 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 00 00 0e 80 02 65 6e 02 00 06 20 20 20 20 20 ┆ en ┆