|
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: 16384 (0x4000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Init, seg_00f4d5, separate Bus
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
separate (Bus)
package body Init is
package Natural_Io is new Text_Io.Integer_Io (Num => Natural);
use Natural_Io;
-- 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 Debug_Plan_Memoire is
begin
for I in Num_Bloc loop
Text_Io.Put (" Bloc :");
Put (I);
Text_Io.Put_Line (T_Mem'Image (Descr_Memoire (I).Type_De_Mem));
end loop;
end Debug_Plan_Memoire;
------------------------------------------------------
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;
-- Initialisation de la memoire a FF
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 Lit_Ligne_Hexa (Ligne : Chaine) is
Ligne_Hexa : Chaine_80 := Ligne.Contenu;
Ad, Compt, Octet : Natural := 0;
begin
for I in 1 .. 4 loop
Calcul_Hexa (Ad, Ligne_Hexa (I));
end loop;
for I in 5 .. 6 loop
Calcul_Hexa (Compt, Ligne_Hexa (I));
end loop;
for Num_Octet in 1 .. Compt loop
declare
J : Natural := 7 + (Num_Octet - 1) * 2;
begin
Octet := 0;
for I in J .. (J + 1) loop
Calcul_Hexa (Octet, Ligne_Hexa (I));
end loop;
Tache_Memoire.Acces_Octet (Memoire.Ecrire, Ad, Octet);
-- Text_Io.Put ("adresse :");
-- Put (Ad);
-- Text_Io.Put (" octet :");
-- Put (Octet);
-- Text_Io.Put_Line ("");
Ad := Ad + 1;
end;
end loop;
end Lit_Ligne_Hexa;
------------------------------------------------------
procedure Lire_Fichier_Hexa (Nom : Chaine_80) is
Fichier : Text_Io.File_Type;
Ligne : Chaine;
begin
Text_Io.Open (Fichier, Text_Io.In_File, Nom);
while not Text_Io.End_Of_File (Fichier) loop
if not Text_Io.End_Of_Line (Fichier) then
Text_Io.Get_Line (Fichier, Ligne.Contenu, Ligne.Indice);
Lit_Ligne_Hexa (Ligne);
else
Text_Io.Skip_Line (Fichier);
end if;
end loop;
Text_Io.Close (Fichier);
end Lire_Fichier_Hexa;
------------------------------------------------------
-- ANALYSE DU FICHIER
------------------------------------------------------
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 =>
Text_Io.Put ("ZONE RAM DE ");
Put (Hexa_1);
Text_Io.Put (" A ");
Put (Hexa_2);
Text_Io.Put_Line ("");
Init_Blocs_Mem (Ram);
when Rom =>
Text_Io.Put ("ZONE ROM DE ");
Put (Hexa_1);
Text_Io.Put (" A ");
Put (Hexa_2);
Text_Io.Put_Line ("");
Init_Blocs_Mem (Rom);
when Fichier =>
Text_Io.Put ("LIRE LE FICHIER HEXA ");
Text_Io.Put_Line (Nom_Fichier.Contenu);
Lire_Fichier_Hexa (Nom_Fichier.Contenu);
when Rien =>
Text_Io.Put_Line ("RIEN");
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
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 Caractere in 'a' .. 'z' then
Caractere := Character'Val
(Character'Pos (Caractere) -
Character'Pos ('a') + Character'Pos ('A'));
end if;
if not ((Caractere in '0' .. '9') or
(Caractere in 'A' .. 'Z')) 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);
-- Debug_Plan_Memoire;
end Initialisation;
end Init;
nblk1=f
nid=c
hdr6=1a
[0x00] rec0=29 rec1=00 rec2=01 rec3=05e
[0x01] rec0=0f rec1=00 rec2=0e rec3=00a
[0x02] rec0=25 rec1=00 rec2=02 rec3=01a
[0x03] rec0=24 rec1=00 rec2=0a rec3=00c
[0x04] rec0=22 rec1=00 rec2=0d rec3=08a
[0x05] rec0=0b rec1=00 rec2=0f rec3=000
[0x06] rec0=25 rec1=00 rec2=0b rec3=004
[0x07] rec0=22 rec1=00 rec2=09 rec3=04a
[0x08] rec0=21 rec1=00 rec2=07 rec3=028
[0x09] rec0=24 rec1=00 rec2=06 rec3=052
[0x0a] rec0=26 rec1=00 rec2=05 rec3=01c
[0x0b] rec0=26 rec1=00 rec2=04 rec3=042
[0x0c] rec0=1d rec1=00 rec2=03 rec3=000
[0x0d] rec0=03 rec1=00 rec2=0c rec3=000
[0x0e] rec0=03 rec1=00 rec2=0c rec3=000
tail 0x2150b562e822b4fe4e2b2 0x42a00088462060003
Free Block Chain:
0xc: 0000 00 08 00 20 80 0b 69 61 6c 69 73 61 74 69 6f 6e ┆ ialisation┆
0x8: 0000 00 00 00 88 80 0f 4c 69 6e 65 20 28 46 69 63 68 ┆ Line (Fich┆