DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦fcecfbbda⟧ TextFile

    Length: 13880 (0x3638)
    Types: TextFile
    Names: »B«

Derivation

└─⟦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⟧ 

TextFile

with Erreur;
with Octet;
with Mot, Verif_Input, Ihm, Text_Io;

package body Memoire is

    Err_Badvalue : constant Natural := 60;

    -- TYPES ----------------------------------------------------------------

    type Mem is array (0 .. Adresse.Val_Max_Adresse) of Octet.T_Octet;
    task type T_Memoire is
        entry Acces_Octet (Operation : T_Operation;
                           Ad : Adresse.T_Adresse;
                           Donnee : in out Octet.T_Octet);
        entry Even (What_Kind : Ihm.Event.Kind;
                    Field_Name : String;
                    Value : String);
    end T_Memoire;
    type T_Dump_Tab is
        record
            Present : Boolean;
            Adr : Adresse.T_Adresse;
        end record;
    type Pt_Tache_Memoire is access T_Memoire;


    -- VARIABLES ------------------------------------------------------------

    La_Memoire : Mem := (others => 0);
    Dump_Tab : array (0 .. 9) of T_Dump_Tab;
    Aff_Actif : Boolean := False;
    Tache_Memoire : Pt_Tache_Memoire;
    Window_Id : Ihm.Window_Id;


    -- PROCEDURES ----------------------------------------------------------

    procedure Reset_Dump_Tab;

    procedure Creer is
    begin
        Tache_Memoire := new T_Memoire;
    end Creer;

    --------------------------------------

    procedure Open_Window (Wid : Ihm.Window_Id) is
    begin
        Window_Id := Wid;
        Aff_Actif := True;
        Reset_Dump_Tab;
    end Open_Window;

    ---------------------------------

    function Traiter_Ligne_Hexa (Ligne : String) return Boolean is
        Defaut : Boolean := False;
        Ad_Deb_Chargement, Ad_Fin_Chargement, Ad_Chargement : Adresse.T_Adresse;
        Cpt_Octet, Type_Ligne, Checksum, Un_Octet : Octet.T_Octet := 0;
        I : Positive;
    begin
        if Ligne (1) /= ':' then  
            Defaut := True;
        else
            Cpt_Octet := Octet.Convert_Ascii_Octet (Ligne (2), Ligne (3));
            Ad_Deb_Chargement := Mot.Convert_Ascii_Mot (Ligne (4), Ligne (5),
                                                        Ligne (6), Ligne (7));  
            Type_Ligne := Octet.Convert_Ascii_Octet (Ligne (8), Ligne (9));
            Checksum := Octet.Add (Cpt_Octet,
                                   Mot.Poids_Fort (Ad_Deb_Chargement));
            Checksum := Octet.Add (Checksum,
                                   Mot.Poids_Faible (Ad_Deb_Chargement));
            Checksum := Octet.Add (Checksum, Type_Ligne);
            I := 10;
            if Type_Ligne = 0 then
                Ad_Fin_Chargement :=
                   Mot.Add (Ad_Deb_Chargement, Mot.Construire (0, Cpt_Octet));
                -- Chargement de la ligne ---------------------
                Ad_Chargement := Ad_Deb_Chargement;
                while Ad_Chargement /= Ad_Fin_Chargement loop
                    Un_Octet := Octet.Convert_Ascii_Octet
                                   (Ligne (I), Ligne (I + 1));
                    I := I + 2;
                    Checksum := Octet.Add (Checksum, Un_Octet);
                    Memoire.Acces_Octet (Ecrire, Ad_Chargement, Un_Octet);
                    Ad_Chargement := Mot.Add
                                        (Ad_Chargement, Mot.Construire (0, 1));
                end loop;
            end if;
            -- Verification du checksum -------------------
            Un_Octet := Octet.Convert_Ascii_Octet (Ligne (I), Ligne (I + 1));
            Checksum := Octet.Add (Checksum, Un_Octet);
            if Checksum /= 0 then
                Defaut := True;
            end if;
        end if;
        if Defaut then
            -- Erreur sur la lecture du fichier hexa;
            Erreur.Detectee (6);
        end if;
        return Defaut;
    end Traiter_Ligne_Hexa;

    --------------------------------------

    procedure Charger_Fichier (Nom : String) is
        Fichier : Text_Io.File_Type;
        Ligne : String (1 .. 80) := (others => '0');
        Longueur : Natural := 0;
        Defaut : Boolean := False;
    begin
        Text_Io.Open (Fichier, Text_Io.In_File, Nom);
        while not Text_Io.End_Of_File (Fichier) and then not Defaut loop
            if not Text_Io.End_Of_Line (Fichier) then
                Text_Io.Get_Line (Fichier, Ligne, Longueur);
                Defaut := Traiter_Ligne_Hexa (Ligne);
            else
                Text_Io.Skip_Line (Fichier);
            end if;
        end loop;
        Text_Io.Close (Fichier);
    exception
        when Text_Io.Name_Error =>
            --Nom de fichier Hexa inconnu !!!
            Erreur.Detectee (5);
    end Charger_Fichier;

    --------------------------------------

    procedure Acces_Octet (Operation : T_Operation;
                           Ad : Adresse.T_Adresse;
                           Donnee : in out Octet.T_Octet) is
    begin
        Tache_Memoire.Acces_Octet (Operation, Ad, Donnee);
    end Acces_Octet;

    --------------------------------------

    procedure Detruire is
    begin
        abort Tache_Memoire.all;
    end Detruire;

    --------------------------------------

    procedure Dispatch_Event (What_Kind : Ihm.Event.Kind;
                              Field_Name : String;
                              Value : String) is
    begin
        Tache_Memoire.Even (What_Kind, Field_Name, Value);
    end Dispatch_Event;


    -- TACHE ----------------------------------------------------------------

    procedure Refresh_Dump_Tab_Input (No_Lig : Integer) is
    begin
        if Dump_Tab (No_Lig).Present then
            Ihm.Window.Put_Field
               (Window_Id, "BB.F1.Input.Lig" & Integer'Image (No_Lig) (2 .. 2),
                Mot.Convert_Mot_String (Dump_Tab (No_Lig).Adr));
        else
            Ihm.Window.Put_Field
               (Window_Id,
                "BB.F1.Input.Lig" & Integer'Image (No_Lig) (2 .. 2), "");
        end if;
    end Refresh_Dump_Tab_Input;

    procedure Refresh_Dump_Tab_Dump (No_Lig : Integer) is
        Str_Dump : String (1 .. 47) := (others => ' ');
        I : Integer := 1;
    begin
        if Dump_Tab (No_Lig).Present then
            for No_Octet in 0 .. 15 loop
                Octet.Convert_Octet_Ascii
                   (La_Memoire (Dump_Tab (No_Lig).Adr + No_Octet),
                    Str_Dump (I), Str_Dump (I + 1));
                I := I + 3;  
            end loop;
        end if;
        Ihm.Window.Put_Field
           (Window_Id, "BB.F2.Dump.Lig" & Integer'Image (No_Lig) (2 .. 2),
            Str_Dump);
    end Refresh_Dump_Tab_Dump;

    procedure Refresh_Dump_Tab_Ascii (No_Lig : Integer) is
        Str_Ascii : String (1 .. 16) := (others => ' ');
        I : Integer := 1;
    begin
        if Dump_Tab (No_Lig).Present then
            for No_Octet in 0 .. 15 loop
                if La_Memoire (Dump_Tab (No_Lig).Adr + No_Octet) >=
                   Character'Pos (' ') and
                   La_Memoire (Dump_Tab (No_Lig).Adr + No_Octet) <=
                      Character'Pos ('~') then
                    Str_Ascii (I) :=
                       Character'Val (La_Memoire
                                         (Dump_Tab (No_Lig).Adr + No_Octet));
                else
                    Str_Ascii (I) := '.';
                end if;
                I := I + 1;  
            end loop;
        end if;
        Ihm.Window.Put_Field
           (Window_Id, "BB.F3.Ascii.Lig" & Integer'Image (No_Lig) (2 .. 2),
            Str_Ascii);
    end Refresh_Dump_Tab_Ascii;

    procedure Refresh_Dump_Tab (No_Lig : Integer) is
    begin
        Refresh_Dump_Tab_Input (No_Lig);
        Refresh_Dump_Tab_Dump (No_Lig);
        Refresh_Dump_Tab_Ascii (No_Lig);
    end Refresh_Dump_Tab;

    procedure Modif_Mem_Aff (Ad : Adresse.T_Adresse) is
    begin
        for I in Dump_Tab'Range loop
            if Dump_Tab (I).Present and then Ad >= Dump_Tab (I).Adr and then
               Ad <= Dump_Tab (I).Adr + 15 then
                Refresh_Dump_Tab_Dump (I);
                Refresh_Dump_Tab_Ascii (I);
            end if;
        end loop;
    end Modif_Mem_Aff;

    procedure Modif_Mem (Ad : Adresse.T_Adresse; No_Lig : Integer) is
    begin
        for I in Dump_Tab'Range loop
            if Dump_Tab (I).Present and then I /= No_Lig and then
               Ad >= Dump_Tab (I).Adr and then Ad <= Dump_Tab (I).Adr + 15 then
                Refresh_Dump_Tab_Dump (I);
                Refresh_Dump_Tab_Ascii (I);
            end if;
        end loop;
    end Modif_Mem;

    procedure Reset_Dump_Tab is
    begin
        for I in Dump_Tab'Range loop
            Dump_Tab (I).Present := False;
        end loop;
    end Reset_Dump_Tab;

    procedure Close_Window is
    begin
        Aff_Actif := False;
    end Close_Window;

    procedure Delete_All is
    begin
        Reset_Dump_Tab;
        for I in Dump_Tab'Range loop
            Refresh_Dump_Tab (I);
        end loop;
    end Delete_All;

    procedure Input (Value : String; No_Lig : Integer) is
    begin
        if Value = "" then
            Dump_Tab (No_Lig).Present := False;
            Refresh_Dump_Tab (No_Lig);
        else
            if Verif_Input.Is_Hexadecimal_Word_Value (Value) and then
               Mot.Convert_String_Mot (Value) <= 16#FFF0# then
                Dump_Tab (No_Lig).Present := True;
                Dump_Tab (No_Lig).Adr := Mot.Convert_String_Mot (Value);
                Refresh_Dump_Tab (No_Lig);
            else
                Erreur.Detectee (Err_Badvalue);
                Refresh_Dump_Tab_Input (No_Lig);
            end if;
        end if;
    end Input;

    procedure Dump (Value : String; No_Lig : Integer) is
        Donnee : Octet.T_Octet;
        I : Integer;
        Ok : Boolean := True;
        Str : String (1 .. 2);
    begin
        if Dump_Tab (No_Lig).Present then
            I := Value'First;
            for No_Octet in 0 .. 15 loop
                Str := Value (I .. I + 1);
                if not Verif_Input.Is_Hexadecimal_Byte_Value (Str) then
                    Ok := False;
                end if;
                if No_Octet /= 15 then
                    I := I + 2;
                    if Value (I) /= ' ' then
                        Ok := False;
                    end if;
                    I := I + 1;
                end if;
            end loop;
            if Ok then
                I := Value'First;
                for No_Octet in 0 .. 15 loop
                    Donnee := Octet.Convert_Ascii_Octet
                                 (Value (I), Value (I + 1));
                    La_Memoire (Dump_Tab (No_Lig).Adr + No_Octet) := Donnee;
                    I := I + 3;  
                end loop;
                Refresh_Dump_Tab_Dump (No_Lig);
                Refresh_Dump_Tab_Ascii (No_Lig);
                for J in Dump_Tab'Range loop
                    if Dump_Tab (J).Present and then J /= No_Lig and then
                       ((Dump_Tab (No_Lig).Adr >= Dump_Tab (J).Adr and
                         Dump_Tab (No_Lig).Adr <= Dump_Tab (J).Adr + 15) or
                        (Dump_Tab (No_Lig).Adr + 15 >= Dump_Tab (J).Adr and
                         Dump_Tab (No_Lig).Adr + 15 <= Dump_Tab (J).Adr + 15))  
                        then
                        Refresh_Dump_Tab_Dump (J);
                        Refresh_Dump_Tab_Ascii (J);
                    end if;
                end loop;
            else
                Erreur.Detectee (Err_Badvalue);
                Refresh_Dump_Tab_Dump (No_Lig);
            end if;
        else
            Erreur.Detectee (Err_Badvalue);
            Refresh_Dump_Tab_Dump (No_Lig);
        end if;
    end Dump;

    task body T_Memoire is
    begin
        while True loop
            select
                accept Acces_Octet (Operation : T_Operation;
                                    Ad : Adresse.T_Adresse;
                                    Donnee : in out Octet.T_Octet) do
                    case Operation is
                        when Lire =>
                            Donnee := La_Memoire (Ad);
                        when Ecrire =>
                            La_Memoire (Ad) := Donnee;
                            if Aff_Actif then
                                Modif_Mem_Aff (Ad);
                            end if;
                    end case;
                end Acces_Octet;
            or
                accept Even (What_Kind : Ihm.Event.Kind;
                             Field_Name : String;
                             Value : String) do
                    case What_Kind is
                        when Ihm.Event.Pushbutton =>
                            if Field_Name = "Cancel" then
                                Close_Window;
                            elsif Field_Name = "DeleteAll" then
                                Delete_All;
                            else
                                Text_Io.Put_Line
                                   ("ERROR memoire, invalid field event");
                            end if;
                        when Ihm.Event.Fieldenter =>
                            if Field_Name (1 .. 5) = "Input" then
                                Input (Value, Integer'Value
                                                 (Field_Name (6 .. 6)));
                            elsif Field_Name (1 .. 4) = "Dump" then
                                Dump (Value, Integer'Value
                                                (Field_Name (5 .. 5)));
                            else
                                Text_Io.Put_Line
                                   ("ERROR memoire, invalid field event");
                            end if;
                        when others =>
                            Text_Io.Put_Line
                               ("ERROR memoire, invalid field event");
                    end case;
                end Even;
            end select;
        end loop;
    end T_Memoire;

end Memoire;