DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦8c3b37e99⟧ Ada Source

    Length: 18432 (0x4800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Initialisation, seg_020f06

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Text_Io;

package body Initialisation 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 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;

        Adresse, Compt, Octet : Natural := 0;

    begin

        for I in 1 .. 4 loop
            Calcul_Hexa (Adresse, 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;

                Text_Io.Put ("adresse :");
                Put (Adresse);
                Text_Io.Put ("  octet :");
                Put (Octet);
                Text_Io.Put_Line ("");

                Adresse := Adresse + 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 Init (Nom_De_Fichier : String) is

        use Text_Io;

        Fichier              : File_Type;
        Caractere, Precedent : Character := ' ';


    begin
        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);
    end Init;


end Initialisation;

E3 Meta Data

    nblk1=11
    nid=0
    hdr6=22
        [0x00] rec0=28 rec1=00 rec2=01 rec3=054
        [0x01] rec0=02 rec1=00 rec2=10 rec3=06c
        [0x02] rec0=21 rec1=00 rec2=08 rec3=058
        [0x03] rec0=22 rec1=00 rec2=02 rec3=008
        [0x04] rec0=27 rec1=00 rec2=03 rec3=00a
        [0x05] rec0=00 rec1=00 rec2=11 rec3=036
        [0x06] rec0=25 rec1=00 rec2=0f rec3=02c
        [0x07] rec0=00 rec1=00 rec2=04 rec3=012
        [0x08] rec0=24 rec1=00 rec2=0e rec3=082
        [0x09] rec0=02 rec1=00 rec2=0b rec3=038
        [0x0a] rec0=22 rec1=00 rec2=0c rec3=072
        [0x0b] rec0=02 rec1=00 rec2=06 rec3=016
        [0x0c] rec0=21 rec1=00 rec2=07 rec3=00c
        [0x0d] rec0=02 rec1=00 rec2=05 rec3=002
        [0x0e] rec0=23 rec1=00 rec2=0d rec3=04a
        [0x0f] rec0=29 rec1=00 rec2=09 rec3=056
        [0x10] rec0=1f rec1=00 rec2=0a rec3=000
    tail 0x2151c85d2838d4c1b52e8 0x42a00088462062803