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 - 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;