|
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: 8523 (0x214b)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Gui_Interface;
separate (Bus)
package body Init is
-- CONSTANTES ---------------------------------------
Nb_De_Mots_Cles : constant := 3;
-- ( RAM, ROM ,FICHIER )
-- TYPES --------------------------------------------
type Etat_Analyseur is (Depart, Lire_Mot_Cle, Lire_Hexa_1,
Lire_Hexa_2, Lire_Nom_Fichier);
type Code is (Rien, Ram, Rom, Fichier);
subtype Chaine_80 is String (1 .. 80);
type Chaine is
record
Indice : Natural := 1;
Contenu : Chaine_80 := (others => ' ');
end record;
-- VARIABLES -----------------------------------------
Etat : Etat_Analyseur := Depart;
Mot_Cle : Chaine;
Nom_Fichier : Chaine;
Hexa_1, Hexa_2 : Natural := 0;
Code_A_Executer : Code := Rien;
------------------------------------------------------
-- PROCEDURES
------------------------------------------------------
procedure Init_Memoire is
begin
-- Initialisation de la table descripteur
for I in Num_Bloc loop
Descr_Memoire (I).Bloc_Physique := I;
Descr_Memoire (I).Type_De_Mem := Rien;
end loop;
end Init_Memoire;
------------------------------------------------------
procedure Init_Blocs_Mem (Avec_Le_Code : Code) is
Bloc_Depart, Bloc_Fin : Num_Bloc := 0;
Config : T_Mem := Rien;
begin
if Avec_Le_Code = Ram then
Config := Ram;
elsif Avec_Le_Code = Rom then
Config := Rom;
end if;
Bloc_Depart := Hexa_1 / Taille_Bloc_Mem;
Bloc_Fin := Hexa_2 / Taille_Bloc_Mem;
Descr_Memoire (Bloc_Depart).Type_De_Mem := Config;
for I in Bloc_Depart .. Bloc_Fin loop
Descr_Memoire (I).Type_De_Mem := Config;
end loop;
end Init_Blocs_Mem;
------------------------------------------------------
procedure Calcul_Hexa (Hexa : in out Natural; Car : Character) is
begin
if Car in '0' .. '9' then
Hexa := Hexa * 16 + Character'Pos (Car) - Character'Pos ('0');
elsif Car in 'A' .. 'F' then
Hexa := Hexa * 16 + 10 + Character'Pos (Car) - Character'Pos ('A');
end if;
end Calcul_Hexa;
------------------------------------------------------
procedure Lire_Fichier_Hexa (Nom : Chaine_80) is
I : Positive := 1;
begin
while Nom (I) /= ' ' loop
I := I + 1;
end loop;
declare
Nom_Fichier : String (1 .. I - 1) := Nom (1 .. I - 1);
begin
Memoire.Charger_Fichier (Nom_Fichier);
end;
end Lire_Fichier_Hexa;
-----------------------------------------------------
procedure Reset is
begin
Mot_Cle.Indice := 1;
Mot_Cle.Contenu := (others => ' ');
Nom_Fichier.Indice := 1;
Nom_Fichier.Contenu := (others => ' ');
Hexa_1 := 0;
Hexa_2 := 0;
Code_A_Executer := Rien;
end Reset;
------------------------------------------------------
procedure Interprete is
begin
case Code_A_Executer is
when Ram =>
Init_Blocs_Mem (Ram);
when Rom =>
Init_Blocs_Mem (Rom);
when Fichier =>
Lire_Fichier_Hexa (Nom_Fichier.Contenu);
when Rien =>
null;
end case;
Reset;
end Interprete;
------------------------------------------------------
procedure Construire (Nom : in out Chaine; Car : Character) is
begin
if Nom.Indice < 80 then
Nom.Contenu (Nom.Indice) := Car;
Nom.Indice := Nom.Indice + 1;
end if;
end Construire;
------------------------------------------------------
function Construire_Nom_Fichier (Car : Character) return Etat_Analyseur is
Etat_Retour : Etat_Analyseur := Lire_Nom_Fichier;
begin
if Car /= ' ' then
Construire (Nom_Fichier, Car);
else
Interprete;
Etat_Retour := Depart;
end if;
return Etat_Retour;
end Construire_Nom_Fichier;
------------------------------------------------------
function Verifier_Mot_Cle return Etat_Analyseur is
Code_Ram : constant Chaine_80 := ('R', 'A', 'M', others => ' ');
Code_Rom : constant Chaine_80 := ('R', 'O', 'M', others => ' ');
Code_Fichier : constant Chaine_80 :=
('F', 'I', 'C', 'H', 'I', 'E', 'R', others => ' ');
Etat_Retour : Etat_Analyseur := Depart;
begin
if Mot_Cle.Contenu = Code_Ram then
Etat_Retour := Lire_Hexa_1;
Code_A_Executer := Ram;
elsif Mot_Cle.Contenu = Code_Rom then
Etat_Retour := Lire_Hexa_1;
Code_A_Executer := Rom;
elsif Mot_Cle.Contenu = Code_Fichier then
Etat_Retour := Lire_Nom_Fichier;
Code_A_Executer := Fichier;
else
Etat_Retour := Depart;
Code_A_Executer := Rien;
end if;
return Etat_Retour;
end Verifier_Mot_Cle;
------------------------------------------------------
function Construire_Mot_Cle (Car : Character) return Etat_Analyseur is
Etat_Retour : Etat_Analyseur := Lire_Mot_Cle;
begin
if Car /= ' ' then
Construire (Mot_Cle, Car);
elsif Etat /= Depart then
Etat_Retour := Verifier_Mot_Cle;
end if;
return Etat_Retour;
end Construire_Mot_Cle;
------------------------------------------------------
function Calculer_Hexa_1 (Car : Character) return Etat_Analyseur is
Etat_Retour : Etat_Analyseur := Lire_Hexa_1;
begin
if Car = ' ' then
Etat_Retour := Lire_Hexa_2;
else
Calcul_Hexa (Hexa_1, Car);
end if;
return Etat_Retour;
end Calculer_Hexa_1;
------------------------------------------------------
function Calculer_Hexa_2 (Car : Character) return Etat_Analyseur is
Etat_Retour : Etat_Analyseur := Lire_Hexa_2;
begin
if Car = ' ' then
Interprete;
Etat_Retour := Depart;
else
Calcul_Hexa (Hexa_2, Car);
end if;
return Etat_Retour;
end Calculer_Hexa_2;
------------------------------------------------------
procedure Decode (Car : Character) is
begin
case Etat is
when Depart | Lire_Mot_Cle =>
Etat := Construire_Mot_Cle (Car);
when Lire_Hexa_1 =>
Etat := Calculer_Hexa_1 (Car);
when Lire_Hexa_2 =>
Etat := Calculer_Hexa_2 (Car);
when Lire_Nom_Fichier =>
Etat := Construire_Nom_Fichier (Car);
end case;
end Decode;
--------------------------------------------------------
procedure Initialisation (Nom_De_Fichier : String) is
use Text_Io;
Fichier : File_Type;
Caractere, Precedent : Character := ' ';
begin
if Nom_De_Fichier (Nom_De_Fichier'Last - 1 .. Nom_De_Fichier'Last) =
".x" then
Memoire.Charger_Fichier (Nom_De_Fichier);
else
Init_Memoire;
Open (Fichier, In_File, Nom_De_Fichier);
while not End_Of_File (Fichier) loop
while not End_Of_Line (Fichier) loop
Get (Fichier, Caractere);
if not ((Caractere in '0' .. '9') or
(Caractere in 'A' .. 'Z') or
(Caractere in 'a' .. 'z') or
(Caractere = '.') or (Caractere = '_')) then
Caractere := ' ';
end if;
if not (Caractere = ' ' and Precedent = ' ') then
Decode (Caractere);
end if;
Precedent := Caractere;
end loop;
Skip_Line (Fichier);
Caractere := ' ';
if Precedent /= ' ' then
Decode (Caractere);
end if;
Precedent := Caractere;
end loop;
Close (Fichier);
end if;
exception
when Text_Io.Name_Error =>
--Fichier de configuration inconnu !!!
Erreur.Detectee (4);
end Initialisation;
end Init;