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

⟦38fcf588a⟧ TextFile

    Length: 17448 (0x4428)
    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 Z80, Z80_Defs, Memoire, Adresse, Octet, Erreur, Periph, Mot, Text_Io, Lex;

package body Bus is

    -- CONSTANTES -----------------------------------------------------------

    Taille_Bloc_Mem : constant Positive := 256;
    Nb_De_Blocs : constant Natural := 256;
    Nb_Max_Iomem : constant Natural := 300;
    Err_Memnullreadacces : constant Natural := 10;
    Err_Memnullwriteacces : constant Natural := 11;
    Err_Memromwriteacces : constant Natural := 12;
    Err_Ioport : constant Natural := 13;
    Err_Iomem : constant Natural := 14;
    Err_Configfilenotfound : constant Natural := 15;
    Err_Configfile : constant Natural := 16;

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

    type T_Descripteur_Periph is
        record
            Vector : Octet.T_Octet;
            It_Demandee : Boolean := False;
        end record;

    type T_Ioport is
        record
            Id_Periph : Periph.T_Periph_Number;
            No_Reg : Natural := 0;
        end record;
    type T_Iomem is
        record
            Ad : Adresse.T_Adresse;
            Id_Periph : Periph.T_Periph_Number;
            No_Reg : Natural := 0;
        end record;

    type T_Mem is (Rien, Ram, Rom, Io_Periph);
    subtype Num_Bloc is Natural range 0 .. (Nb_De_Blocs - 1);
    type T_Descripteur_Memoire is
        record
            Bloc_Physique : Num_Bloc := 0;  
            Type_De_Mem : T_Mem := Rien;
        end record;

    task type T_Bus is
        entry Acces_Octet (Quelle_Operation : Z80.T_Operation;
                           Ad : Adresse.T_Adresse;
                           Donnee : in out Octet.T_Octet);
        entry Reset;
    end T_Bus;
    task type T_It is
        entry It_From_Periph (Id_Periph : Periph.T_Periph_Number;
                              Vector : Octet.T_Octet);
        entry It_Ack (Vector : out Octet.T_Octet);
        entry Reset;
    end T_It;
    type Pt_Tache_Bus is access T_Bus;
    type Pt_Tache_It is access T_It;


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

    It_En_Trait : Boolean := False;
    Id_Periph_It_En_Trait : Periph.T_Periph_Number;
    Descr_Memoire : array (Num_Bloc) of T_Descripteur_Memoire;
    Descr_Periph : array (Periph.T_Periph_Number) of T_Descripteur_Periph;
    Ioport : array (0 .. 255) of T_Ioport;
    Iomem : array (1 .. Nb_Max_Iomem) of T_Iomem;
    Nb_Iomem : Natural := 0;
    Tache_Bus : Pt_Tache_Bus;
    Tache_It : Pt_Tache_It;


    -- PROCEDURES avec vue exterieur----------------------------------

    procedure Creer is
    begin
        Tache_Bus := new T_Bus;
        Tache_It := new T_It;
    end Creer;

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

    procedure Initialisation (Nom_De_Fichier : String) is
        Fin : Boolean := False;

        procedure Init_Memoire is
        begin
            for I in Num_Bloc loop
                Descr_Memoire (I).Bloc_Physique := I;
                Descr_Memoire (I).Type_De_Mem := Rien;
            end loop;
            for I in Ioport'Range loop
                Ioport (I).Id_Periph := 0;
                Ioport (I).No_Reg := 0;
            end loop;
            for I in 1 .. Nb_Iomem loop
                Iomem (I).Id_Periph := 0;
                Iomem (I).No_Reg := 0;
            end loop;
            Nb_Iomem := 0;
        end Init_Memoire;

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

        procedure Init_Bloc (Adr_Begin, Adr_End : Integer; Config : T_Mem) is
            Bloc_Depart, Bloc_Fin : Num_Bloc := 0;
        begin
            Bloc_Depart := Adr_Begin / Taille_Bloc_Mem;
            Bloc_Fin := Adr_End / Taille_Bloc_Mem;
            for I in Bloc_Depart .. Bloc_Fin loop
                Descr_Memoire (I).Type_De_Mem := Config;
            end loop;
        end Init_Bloc;

        function Init_Blocs_Mem return Boolean is
            Adr_Depart, Adr_Fin : Integer;
            Config : T_Mem;
        begin
            if Lex.Getvalue = "RAM" then
                Config := Ram;
            else
                Config := Rom;
            end if;
            Lex.Getnext;
            if Lex."/=" (Lex.Gettoken, Lex.Number) then
                return False;
            end if;
            Adr_Depart := Lex.Getvalue;
            Lex.Getnext;
            if Lex."/=" (Lex.Gettoken, Lex.Number) then
                return False;
            end if;
            Adr_Fin := Lex.Getvalue;
            Lex.Getnext;
            Init_Bloc (Adr_Depart, Adr_Fin, Config);
            return True;
        end Init_Blocs_Mem;

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

        function Periphe return Boolean is
            Periph_Type : constant String := Lex.Getvalue;
            It_Vector : Integer;
            Basic_Address : Integer;
            Memory_Mapped : Boolean := False;
            It_Connected : Boolean := False;
            Number_Of_Register : Natural := 0;
            Id_Periph : Periph.T_Periph_Number;
        begin
            Lex.Getnext;
            if Lex."/=" (Lex.Gettoken, Lex.Str) or else
               (Lex.Getvalue /= "M" and Lex.Getvalue /= "P") then
                return False;
            end if;
            if Lex.Getvalue = "M" then
                Memory_Mapped := True;
            end if;
            Lex.Getnext;
            if Lex."/=" (Lex.Gettoken, Lex.Number) then
                return False;
            end if;
            Basic_Address := Lex.Getvalue;
            Lex.Getnext;
            if Lex."/=" (Lex.Gettoken, Lex.Str) or else
               (Lex.Getvalue /= "C" and Lex.Getvalue /= "N") then
                return False;
            end if;
            if Lex.Getvalue = "C" then
                It_Connected := True;
            end if;
            Lex.Getnext;
            if Lex."/=" (Lex.Gettoken, Lex.Number) then
                return False;
            end if;
            It_Vector := Lex.Getvalue;
            Lex.Getnext;
            Periph.Init (Periph_Type, It_Vector, Basic_Address, Memory_Mapped,
                         It_Connected, Number_Of_Register, Id_Periph);
            if Periph."/=" (Id_Periph, 0) then
                if Memory_Mapped then
                    for I in 1 .. Number_Of_Register loop
                        Iomem (Nb_Iomem + 1).Ad := Basic_Address + I - 1;
                        Iomem (Nb_Iomem + 1).Id_Periph := Id_Periph;
                        Iomem (Nb_Iomem + 1).No_Reg := I;
                        Nb_Iomem := Nb_Iomem + 1;
                    end loop;
                    Init_Bloc (Basic_Address,
                               Basic_Address + Number_Of_Register, Io_Periph);
                else
                    for I in 1 .. Number_Of_Register loop
                        Ioport (Basic_Address + I - 1).Id_Periph := Id_Periph;
                        Ioport (Basic_Address + I - 1).No_Reg := I;
                    end loop;
                end if;
                return True;
            else
                return False;
            end if;
        end Periphe;

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

    begin  
        Periph.Kill;
        Init_Memoire;
        if Lex.Open (Nom_De_Fichier) then
            Lex.Getnext;
            while not Fin loop
                case Lex.Gettoken is
                    when Lex.Number =>
                        Erreur.Detectee (Err_Configfile);
                        Fin := True;
                    when Lex.Str =>
                        if Lex.Getvalue = "ROM" or Lex.Getvalue = "RAM" then
                            Fin := not Init_Blocs_Mem;
                        else
                            Fin := not Periphe;
                        end if;
                        if Fin then
                            Erreur.Detectee (Err_Configfile);
                        end if;
                    when Lex.File_End =>
                        Fin := True;
                    when Lex.Unknown =>
                        Erreur.Detectee (Err_Configfile);
                        Fin := True;
                end case;
            end loop;
            Lex.Close;
        else
            Erreur.Detectee (Err_Configfilenotfound);
        end if;
    end Initialisation;

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

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

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

    procedure It_From_Periph (Id_Periph : Periph.T_Periph_Number;
                              Vector : Octet.T_Octet) is
    begin
        Tache_It.It_From_Periph (Id_Periph, Vector);
    end It_From_Periph;

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

    procedure It_Ack (Vector : out Octet.T_Octet) is
    begin
        Tache_It.It_Ack (Vector);
    end It_Ack;

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

    procedure Detruire is
    begin
        Periph.Kill;
        abort Tache_Bus.all;
        abort Tache_It.all;
    end Detruire;

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

    procedure Reset is
    begin
        Tache_Bus.Reset;
        Tache_It.Reset;
    end Reset;


    -- PROCEDURES POUR LECTURE ECRITURE MEMOIRE procedures internes----------

    procedure Search_Periph (Ad : Adresse.T_Adresse;
                             Id_Periph : out Periph.T_Periph_Number;
                             No_Reg : out Natural) is
        I : Natural := 1;
    begin
        while (Iomem (I).Ad /= Ad or Iomem (I).No_Reg = 0) and I < Nb_Iomem loop
            I := I + 1;
        end loop;
        if Iomem (I).Ad /= Ad or Iomem (I).No_Reg = 0 then
            No_Reg := 0;
        else
            Id_Periph := Iomem (I).Id_Periph;
            No_Reg := Iomem (I).No_Reg;
        end if;
    end Search_Periph;

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

    procedure Decode_Adresse (Ad : in out Adresse.T_Adresse; Mem : out T_Mem) is
        Bloc_Log, Bloc_Phy : Num_Bloc := 0;
        Offset : Adresse.T_Adresse := 0;
    begin
        Bloc_Log := Ad / Taille_Bloc_Mem;
        Bloc_Phy := Descr_Memoire (Bloc_Log).Bloc_Physique;
        Mem := Descr_Memoire (Bloc_Phy).Type_De_Mem;
        Offset := Ad mod Taille_Bloc_Mem;
        Ad := Bloc_Phy * Taille_Bloc_Mem + Offset;
    end Decode_Adresse;

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

    procedure Lecture_Ioport (No_Port : Octet.T_Octet;
                              Donnee : in out Octet.T_Octet) is
    begin
        if Ioport (No_Port).No_Reg = 0 then
            --Erreur: Acces a un periph non implemente
            Erreur.Detectee (Err_Ioport);
        else
            Donnee := Periph.Get_Register
                         (Ioport (No_Port).Id_Periph, Ioport (No_Port).No_Reg);
        end if;
    end Lecture_Ioport;

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

    procedure Ecriture_Ioport (No_Port : Octet.T_Octet;
                               Donnee : Octet.T_Octet) is
        Id_Periph : Periph.T_Periph_Number;
        No_Reg : Natural;
    begin
        if Ioport (No_Port).No_Reg = 0 then
            --Erreur: Acces a un periph non implemente
            Erreur.Detectee (Err_Ioport);
        else
            Periph.Put_Register (Ioport (No_Port).Id_Periph,
                                 Ioport (No_Port).No_Reg, Donnee);
        end if;
    end Ecriture_Ioport;

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

    procedure Lecture_Iomem (Ad : Adresse.T_Adresse;
                             Donnee : in out Octet.T_Octet) is
        Id_Periph : Periph.T_Periph_Number;
        No_Reg : Natural;
    begin
        Search_Periph (Ad, Id_Periph, No_Reg);
        if No_Reg = 0 then
            --Erreur: Acces a un periph non mappe en memoire
            Erreur.Detectee (Err_Iomem);
        else
            Donnee := Periph.Get_Register (Id_Periph, No_Reg);
        end if;
    end Lecture_Iomem;

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

    procedure Ecriture_Iomem (Ad : Adresse.T_Adresse; Donnee : Octet.T_Octet) is
        Id_Periph : Periph.T_Periph_Number;
        No_Reg : Natural;
    begin
        Search_Periph (Ad, Id_Periph, No_Reg);
        if No_Reg = 0 then
            --Erreur: Acces a un periph non mappe en memoire
            Erreur.Detectee (Err_Iomem);
        else
            Periph.Put_Register (Id_Periph, No_Reg, Donnee);
        end if;
    end Ecriture_Iomem;

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

    procedure Lecture_Donnee (Ad : Adresse.T_Adresse;
                              Un_Octet : in out Octet.T_Octet) is
        Ad_Donnee : Adresse.T_Adresse := Ad;
        Mem : T_Mem := Rien;
    begin
        Decode_Adresse (Ad_Donnee, Mem);
        case Mem is  
            when Ram | Rom =>
                Memoire.Acces_Octet (Memoire.Lire, Ad_Donnee, Un_Octet);
            when Rien =>
                --Erreur: Lecture a un emplacement memoire non defini !!!
                Erreur.Detectee (Err_Memnullreadacces);
                Memoire.Acces_Octet (Memoire.Lire, Ad_Donnee, Un_Octet);
            when Io_Periph =>
                Lecture_Iomem (Ad_Donnee, Un_Octet);
        end case;
    end Lecture_Donnee;

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

    procedure Ecriture_Donnee (Ad : Adresse.T_Adresse;
                               Donnee : Octet.T_Octet) is
        Un_Octet : Octet.T_Octet := Donnee;
        Ad_Donnee : Adresse.T_Adresse := Ad;
        Mem : T_Mem := Rien;
    begin
        Decode_Adresse (Ad_Donnee, Mem);
        case Mem is  
            when Ram =>
                Memoire.Acces_Octet (Memoire.Ecrire, Ad_Donnee, Un_Octet);
            when Rom =>
                --Erreur: Ecriture en ROM !!!
                Erreur.Detectee (Err_Memromwriteacces);
            when Rien =>
                --Erreur: Ecriture a un emplacement memoire non defini !!!
                Erreur.Detectee (Err_Memnullwriteacces);
            when Io_Periph =>
                Ecriture_Iomem (Ad_Donnee, Un_Octet);
        end case;  
    end Ecriture_Donnee;


    -- TACHES ----------------------------------------------------------------

    task body T_It is

        Nb_It_Demandee : Integer := 0;

        procedure Generate_It is
            I : Periph.T_Periph_Number := Periph.T_Periph_Number'First;
            use Periph;
        begin
            while not Descr_Periph (I).It_Demandee and
                     I < Periph.T_Periph_Number'Last loop
                I := I + 1;
            end loop;
            if Descr_Periph (I).It_Demandee and then
               Z80.Signaler (Z80_Defs.Int) then
                It_En_Trait := True;
                Id_Periph_It_En_Trait := I;
                Nb_It_Demandee := Nb_It_Demandee - 1;
            end if;
        end Generate_It;

        use Periph;
    begin
        while True loop
            select
                accept It_Ack (Vector : out Octet.T_Octet) do
                    Vector := Descr_Periph (Id_Periph_It_En_Trait).Vector;
                    It_En_Trait := False;
                    Descr_Periph (Id_Periph_It_En_Trait).It_Demandee := False;
                end It_Ack;
            or
                accept It_From_Periph (Id_Periph : Periph.T_Periph_Number;
                                       Vector : Octet.T_Octet) do
                    if not It_En_Trait or else
                       Id_Periph_It_En_Trait /= Id_Periph then
                        Descr_Periph (Id_Periph).It_Demandee := True;
                        Descr_Periph (Id_Periph).Vector := Vector;
                        Nb_It_Demandee := Nb_It_Demandee + 1;
                    end if;
                end It_From_Periph;
                if Nb_It_Demandee > 0 and then not It_En_Trait then
                    Generate_It;
                end if;
            or
                accept Reset do
                    for I in Periph.T_Periph_Number loop
                        Descr_Periph (I).It_Demandee := False;
                    end loop;
                    It_En_Trait := False;
                    Nb_It_Demandee := 0;
                end Reset;
                --else
                --  delay (Duration'Small);
                --if Nb_It_Demandee > 0 and then not It_En_Trait then
                --    Generate_It;
                --end if;
            end select;
        end loop;
    end T_It;

    task body T_Bus is
    begin
        while True loop
            select
                accept Acces_Octet (Quelle_Operation : Z80.T_Operation;
                                    Ad : Adresse.T_Adresse;
                                    Donnee : in out Octet.T_Octet) do
                    case Quelle_Operation is
                        when Z80.Fetch | Z80.Memory_Read =>
                            Lecture_Donnee (Ad, Donnee);
                        when Z80.Memory_Write =>
                            Ecriture_Donnee (Ad, Donnee);
                        when Z80.Io_Read =>
                            Lecture_Ioport (Mot.Poids_Faible (Ad), Donnee);
                        when Z80.Io_Write =>
                            Ecriture_Ioport (Mot.Poids_Faible (Ad), Donnee);
                    end case;
                end Acces_Octet;
            or
                accept Reset do
                    Periph.Reset;
                end Reset;
            end select;
        end loop;
    end T_Bus;
end Bus;