|
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: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Init, seg_020edf, separate Bus
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
nblk1=d
nid=a
hdr6=14
[0x00] rec0=26 rec1=00 rec2=01 rec3=05e
[0x01] rec0=27 rec1=00 rec2=0c rec3=018
[0x02] rec0=23 rec1=00 rec2=0b rec3=01e
[0x03] rec0=16 rec1=00 rec2=09 rec3=000
[0x04] rec0=2d rec1=00 rec2=08 rec3=014
[0x05] rec0=1e rec1=00 rec2=07 rec3=006
[0x06] rec0=24 rec1=00 rec2=06 rec3=00e
[0x07] rec0=28 rec1=00 rec2=05 rec3=016
[0x08] rec0=20 rec1=00 rec2=04 rec3=022
[0x09] rec0=1a rec1=00 rec2=03 rec3=000
[0x0a] rec0=0a rec1=00 rec2=03 rec3=000
[0x0b] rec0=18 rec1=00 rec2=03 rec3=000
[0x0c] rec0=2a rec1=40 rec2=00 rec3=000
tail 0x2170da0b4823a6ef3a263 0x42a00088462060003
Free Block Chain:
0xa: 0000 00 02 03 fc 80 32 20 20 20 2d 2d 20 20 20 20 20 ┆ 2 -- ┆
0x2: 0000 00 0d 00 05 80 02 2d 2d 02 3b 04 00 00 00 00 0f ┆ -- ; ┆
0xd: 0000 00 00 00 bf 80 0d 2b 20 31 3b 65 6e 64 20 6c 6f ┆ + 1;end lo┆