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

⟦f23649ba3⟧ Ada Source

    Length: 29696 (0x7400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Port_Serie_68k, seg_04f765

Derivation

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

E3 Source Code



with General_Defs;  
with V_Bits;
with System;

package body Port_Serie_68k is

--========================================================
-- Fonctions Privees, Non declarees dans la specification
--========================================================

    function Calcul_Adresse_Port
                (Port_Serie : Port; Index : Integer) return G_Defs.Adresse is
        Resultat : G_Defs.Adresse;
    begin
        Resultat := System."+" (Adresse_Circuit, Index);
        if (Port_Serie = Port_B) then  
            Resultat := System."+" (Resultat, 8);
        end if;

        return Resultat;

    end Calcul_Adresse_Port;

    function Compare_Deux_Registres
                (Registre1 : G_Defs.Byte; Registre2 : G_Defs.Byte)
                return Boolean is  
    begin  
        if V_Bits.Bit_And
              (G_Defs.Byte'Pos (Registre1), G_Defs.Byte'Pos (Registre2)) /=
           0 then
            return True;
        else
            return False;
        end if;
    end Compare_Deux_Registres;

    procedure Test_Transmit_Error (Port_Serie : Port) is
        Reg_Sra : G_Defs.Byte;
        for Reg_Sra use at  
           Calcul_Adresse_Port (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Statut);
    begin
        if Compare_Deux_Registres (Reg_Sra, C_68681.Masque.Parity_Error) =
           True then
            raise Parity_Error;
        elsif Compare_Deux_Registres (Reg_Sra, C_68681.Masque.Framing_Error) =
              True then
            raise Framing_Error;
        elsif Compare_Deux_Registres (Reg_Sra, C_68681.Masque.Overrun_Error) =
              True then
            raise Overrun_Error;
        end if;
    end Test_Transmit_Error;

    function Masquage_Du_Registre
                (Registre : G_Defs.Byte; Mask : C_68681.Masque.Objet)
                return G_Defs.Byte is

        Resultat : Integer;
    begin

        Resultat := V_Bits.Bit_And (G_Defs.Byte'Pos (Registre),
                                    G_Defs.Byte'Pos (Mask (1)));
        Resultat := V_Bits.Bit_Or (Resultat, G_Defs.Byte'Pos (Mask (2)));

        return G_Defs.Byte (Resultat);
    end Masquage_Du_Registre;

    --**********************************************************************
    -- Le DUART 68681 genere le vecteur d'interruption, le PICU 68155
    -- par defaut en genere un egalement il faut donc invalider l'emission
    -- du vecteur d'interruption provenant du PICU
    -- ********************************************************************
    procedure Invalidation_Vecteur_It_68155 is
        Reg_R1_68115, Reg_R0_68115, Reg_R3_68115, Reg_R5_68115, Reg_Tempo :
           G_Defs.Byte;
        for Reg_R0_68115 use at Adresse_Base_Gestionnaire_It;
        for Reg_R1_68115 use at System."+" (Adresse_Base_Gestionnaire_It, 2);
        for Reg_R3_68115 use at System."+" (Adresse_Base_Gestionnaire_It, 6);
        for Reg_R5_68115 use at System."+" (Adresse_Base_Gestionnaire_It, 10);


    begin

        Reg_R3_68115 := 2#00000010#;
        Reg_R5_68115 := 2#00000000#;


        Reg_R0_68115 := 2#00000001#;
        Reg_R1_68115 := 2;

        Reg_R0_68115 := 2#00000101#;
        Reg_R1_68115 := 0;

    end Invalidation_Vecteur_It_68155;

    --********************************************************
    -- Reset du pointeur MR pour etre certain d'ecrire sur MR1
    --********************************************************
    procedure Reset_Pointeur_Mr (Port_Serie : Port) is  
        Reg_Cra, Reg_Tempo : G_Defs.Byte;
        for Reg_Cra use at Calcul_Adresse_Port
                              (Port_Serie => Port_Serie,
                               Index => C_68681.Index.Registre_Commande);
    begin  
        Reg_Cra := C_68681.Masque.Reset_Pointeur_Mr;
    end Reset_Pointeur_Mr;

    --========================================================
    -- Fonctions et procedures publiees dans la specification
    --========================================================

    --*************************************************************
    -- Positionnement de la vitesse en Emission/Reception du DUART
    --*************************************************************
    procedure Pos_Vitesse (Port_Serie : Port; Vitesse : G_Defs.Baud_Rate) is

        Reg_Acr, Reg_Csra : G_Defs.Byte;  
        for Reg_Acr use at Calcul_Adresse_Port
                              (Port_Serie => Port_Serie,
                               Index => C_68681.Index.Registre_Auxiliaire);
        for Reg_Csra use at  
           Calcul_Adresse_Port (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Statut);

    begin

        Reg_Acr := C_68681.Masque.Acr7_1;

        case Vitesse is
            when G_Defs.Bd300 =>
                Reg_Csra := C_68681.Masque.Vitesse_300;
            when G_Defs.Bd600 =>
                Reg_Csra := C_68681.Masque.Vitesse_600;
            when G_Defs.Bd1200 =>
                Reg_Csra := C_68681.Masque.Vitesse_1200;
            when G_Defs.Bd2400 =>
                Reg_Csra := C_68681.Masque.Vitesse_2400;  
            when G_Defs.Bd4800 =>
                Reg_Csra := C_68681.Masque.Vitesse_4800;
            when G_Defs.Bd9600 =>
                Reg_Csra := C_68681.Masque.Vitesse_9600;
            when G_Defs.Bd19200 =>
                Reg_Csra := C_68681.Masque.Vitesse_19200;

        end case;
    end Pos_Vitesse;

    --*****************************************************************
    -- Positionne le type de parite ( None, Even ou Odd )gere par UART
    --*****************************************************************
    procedure Pos_Parite (Port_Serie : Port; Val_Parite : G_Defs.Parite) is
        Mr1, Old_Mr1 : G_Defs.Byte;  
        for Mr1 use at Calcul_Adresse_Port
                          (Port_Serie => Port_Serie,
                           Index => C_68681.Index.Registre_Mode);
    begin

        Reset_Pointeur_Mr (Port_Serie => Port_Serie);
        Old_Mr1 := Mr1;
        Reset_Pointeur_Mr (Port_Serie => Port_Serie);

        case Val_Parite is
            when G_Defs.None =>
                Mr1 := Masquage_Du_Registre
                          (Registre => Old_Mr1,
                           Mask => C_68681.Masque.Sans_Parite);
            when G_Defs.Even =>
                Mr1 := Masquage_Du_Registre
                          (Registre => Old_Mr1,
                           Mask => C_68681.Masque.Parite_Paire);
            when G_Defs.Odd =>
                Mr1 := Masquage_Du_Registre
                          (Registre => Old_Mr1,
                           Mask => C_68681.Masque.Parite_Impair);
        end case;
    end Pos_Parite;

    --**********************************************
    -- Positionne le nombre de Stop Bits  pour UART
    --**********************************************
    procedure Pos_Stop_Bits (Port_Serie : Port;
                             Val_Stop_Bits : G_Defs.Stop_Bits) is

        Mr2, Dummy, Reg_Tempo : G_Defs.Byte;
        for Mr2 use at Calcul_Adresse_Port
                          (Port_Serie => Port_Serie,
                           Index => C_68681.Index.Registre_Mode);
    begin
        Reset_Pointeur_Mr (Port_Serie => Port_Serie);
        Dummy := Mr2; -- Incremente Pointeur Mr a Mr2_x
        Mr2 := Dummy;

        Reg_Tempo := Mr2;

        case Val_Stop_Bits is
            when 1 =>
                Mr2 := Masquage_Du_Registre
                          (Registre => Reg_Tempo,
                           Mask => C_68681.Masque.Un_Stop_Bit);
            when 2 =>
                Mr2 := Masquage_Du_Registre
                          (Registre => Reg_Tempo,
                           Mask => C_68681.Masque.Deux_Stop_Bit);
        end case;   end Pos_Stop_Bits;

    --******************************************************
    -- Positionne le nombre de Bits par caractere pour UART
    --******************************************************
    procedure Pos_Nbre_Bits_Caractere (Port_Serie : Port;
                                       Val_Nbre_Bits_Par_Caractere :
                                          G_Defs.Nbre_Bits_Par_Caractere) is
        Mr1, Old_Mr1 : G_Defs.Byte;  
        for Mr1 use at Calcul_Adresse_Port
                          (Port_Serie => Port_Serie,
                           Index => C_68681.Index.Registre_Mode);
    begin
        Reset_Pointeur_Mr (Port_Serie => Port_Serie);
        Old_Mr1 := Mr1;
        Reset_Pointeur_Mr (Port_Serie => Port_Serie);

        case Val_Nbre_Bits_Par_Caractere is
            when 5 =>
                Mr1 := Masquage_Du_Registre
                          (Registre => Old_Mr1,
                           Mask => C_68681.Masque.Caractere_5_Bit);
            when 6 =>
                Mr1 := Masquage_Du_Registre
                          (Registre => Old_Mr1,
                           Mask => C_68681.Masque.Caractere_6_Bit);  
            when 7 =>
                Mr1 := Masquage_Du_Registre
                          (Registre => Old_Mr1,
                           Mask => C_68681.Masque.Caractere_7_Bit);
            when 8 =>
                Mr1 := Masquage_Du_Registre
                          (Registre => Old_Mr1,
                           Mask => C_68681.Masque.Caractere_8_Bit);
        end case;
    end Pos_Nbre_Bits_Caractere;

    procedure Emission_Reception (Port_Serie : Port;
                                  Mode : Mode_Emission_Reception) is
        Reg_Cra : G_Defs.Byte;  
        for Reg_Cra use at Calcul_Adresse_Port
                              (Port_Serie => Port_Serie,
                               Index => C_68681.Index.Registre_Commande);
    begin
        case Mode is
            when E =>
                Reg_Cra := C_68681.Masque.Validation_Emission;
            when R =>
                Reg_Cra := C_68681.Masque.Validation_Reception;
            when E_R =>
                Reg_Cra := C_68681.Masque.Validation_Emission_Reception;
            when Aucun =>
                Reg_Cra := C_68681.Masque.Aucune_Emission_Reception;

        end case;
    end Emission_Reception;


    --***********************************************************
    -- Configure le masque d'interruption en fct du mode choisi
    --***********************************************************
    procedure Pos_Interruption (Mode : Mode_Emission_Reception) is
        Reg_Int : G_Defs.Byte;
        for Reg_Int use at
           System."+" (Adresse_Circuit,
                       C_68681.Index.Registre_Statut_Masque_Interruption);
    begin  
        Invalidation_Vecteur_It_68155;
        case Mode is
            when E =>
                Reg_Int := C_68681.Masque.Validation_Interruption_Emission;
            when R =>
                Reg_Int := C_68681.Masque.Validation_Interruption_Reception;
            when E_R =>
                Reg_Int := C_68681.Masque.
                              Validation_Interruption_Emission_Reception;
            when Aucun =>
                Reg_Int := C_68681.Masque.Sans_It;
        end case;
    end Pos_Interruption;


    --**************************************************************
    --  Calcul de l'adresse de l'interruption a partir de l'adresse
    --  de base et du numero d'IT
    --**************************************************************
    function Calcul_Adresse_It
                (No_It : Niveau_Interruption) return G_Defs.Adresse is
        Offset : Integer;
        Resultat : G_Defs.Adresse;
        Reg_Ivr : G_Defs.Byte;
        for Reg_Ivr use at Calcul_Adresse_Port
                              (Port_Serie => Port_A,
                               Index => C_68681.Index.Vecteur_Interruption);

    begin
        Reg_Ivr := G_Defs.Byte (No_It);
        Offset := No_It * 4;
        return System."+" (Adresse_Base_It, Offset);
    end Calcul_Adresse_It;


    procedure Interruption_Reception_Sur_R_Rdy (Port_Serie : Port) is
        Mr1, Old_Mr1 : G_Defs.Byte;  
        for Mr1 use at Calcul_Adresse_Port
                          (Port_Serie => Port_Serie,
                           Index => C_68681.Index.Registre_Mode);
    begin
        Reset_Pointeur_Mr (Port_Serie);
        Old_Mr1 := Mr1;
        Reset_Pointeur_Mr (Port_Serie);
        Mr1 := Masquage_Du_Registre (Old_Mr1, C_68681.Masque.R_Int_Select);
    end Interruption_Reception_Sur_R_Rdy;

    --**************************************
    --  Pour une interruption materielle,
    --  donne le type evenement a traiter
    --**************************************
    function Donner_Evenement_Interruption  
                (Port_Serie : Port) return Evenement_Interruption is
        Reg_Isr : G_Defs.Byte;
        for Reg_Isr use at Calcul_Adresse_Port
                              (Port_Serie => Port_A,
                               Index => C_68681.Index.
                                           Registre_Statut_Masque_Interruption);
    begin
        if Compare_Deux_Registres
              (Registre1 => C_68681.Masque.Est_Ce_Reception_A,
               Registre2 => Reg_Isr) = True then
            return Reception_A;
        elsif Compare_Deux_Registres
                 (Registre1 => C_68681.Masque.Est_Ce_Reception_B,
                  Registre2 => Reg_Isr) = True then
            return Reception_B;
        elsif Compare_Deux_Registres
                 (Registre1 => C_68681.Masque.Est_Ce_Emission_A,
                  Registre2 => Reg_Isr) = True then
            return Emission_A;
        elsif Compare_Deux_Registres
                 (Registre1 => C_68681.Masque.Est_Ce_Emission_B,
                  Registre2 => Reg_Isr) = True then
            return Emission_B;
        else
            return Inconnu;
        end if;
    end Donner_Evenement_Interruption;

    function Lire_Donnee (Port_Serie : Port) return G_Defs.Byte is
        Reg_Data, Reg_Csra : G_Defs.Byte;
        for Reg_Data use at Calcul_Adresse_Port
                               (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Donnees);
        for Reg_Csra use at  
           Calcul_Adresse_Port (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Statut);

    begin
        while (Compare_Deux_Registres
                  (Registre1 => Reg_Csra,
                   Registre2 => C_68681.Masque.Recepteur_Pret) = False) loop
            null;
        end loop;

        Test_Transmit_Error (Port_Serie => Port_Serie);

        return Reg_Data;
    end Lire_Donnee;

    --******************************************
    -- Ecrire Octet dans DUART en attent active
    --******************************************
    procedure Ecrire_Donnee (Port_Serie : Port; Donnee : G_Defs.Byte) is
        Reg_Data, Reg_Csra : G_Defs.Byte;
        for Reg_Data use at Calcul_Adresse_Port
                               (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Donnees);
        for Reg_Csra use at  
           Calcul_Adresse_Port (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Statut);
    begin
        while (Compare_Deux_Registres
                  (Registre1 => Reg_Csra,
                   Registre2 => C_68681.Masque.Emetteur_Pret) = False) loop
            null;
        end loop;
        Reg_Data := Donnee;

    end Ecrire_Donnee;

    function Pret_Pour_Ecrire (Port_Serie : Port) return Boolean is
        Reg_Csra : G_Defs.Byte;
        for Reg_Csra use at  
           Calcul_Adresse_Port (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Statut);
    begin
        return
           Compare_Deux_Registres (Registre1 => Reg_Csra,
                                   Registre2 => C_68681.Masque.Emetteur_Pret) =
           True;
    end Pret_Pour_Ecrire;

    function Pret_Pour_Lire (Port_Serie : Port) return Boolean is
        Reg_Csra : G_Defs.Byte;

        for Reg_Csra use at  
           Calcul_Adresse_Port (Port_Serie => Port_Serie,
                                Index => C_68681.Index.Registre_Statut);

    begin
        return (Compare_Deux_Registres
                   (Registre1 => Reg_Csra,
                    Registre2 => C_68681.Masque.Recepteur_Pret) = True);
    end Pret_Pour_Lire;

    procedure Pos_Ivr is
        Reg_Ivr : G_Defs.Byte;
        for Reg_Ivr use at Calcul_Adresse_Port
                              (Port_Serie => Port_A,
                               Index => C_68681.Index.Vecteur_Interruption);
    begin
        Reg_Ivr := G_Defs.Byte (74);
    end Pos_Ivr;



begin
    --***********************************************
    --  Initialisation par defaut des Ports du DUART
    --***********************************************
    for Port_Init in Port'First .. Port'Last loop
        Pos_Interruption (Mode => Aucun);
        Emission_Reception (Port_Serie => Port_Init, Mode => Aucun);
        Interruption_Reception_Sur_R_Rdy (Port_Init);
        Pos_Vitesse (Port_Serie => Port_Init, Vitesse => G_Defs.Bd9600);
        Pos_Parite (Port_Serie => Port_Init, Val_Parite => G_Defs.None);
        Pos_Stop_Bits (Port_Serie => Port_Init, Val_Stop_Bits => 1);
        Pos_Nbre_Bits_Caractere (Port_Serie => Port_Init,
                                 Val_Nbre_Bits_Par_Caractere => 8);
        Pos_Ivr;
    end loop;
end Port_Serie_68k;

E3 Meta Data

    nblk1=1c
    nid=6
    hdr6=24
        [0x00] rec0=22 rec1=00 rec2=01 rec3=010
        [0x01] rec0=1d rec1=00 rec2=13 rec3=00a
        [0x02] rec0=11 rec1=00 rec2=0e rec3=09a
        [0x03] rec0=1e rec1=00 rec2=10 rec3=07c
        [0x04] rec0=18 rec1=00 rec2=05 rec3=018
        [0x05] rec0=16 rec1=00 rec2=04 rec3=030
        [0x06] rec0=19 rec1=00 rec2=1b rec3=056
        [0x07] rec0=1a rec1=00 rec2=0a rec3=002
        [0x08] rec0=15 rec1=00 rec2=1c rec3=082
        [0x09] rec0=18 rec1=00 rec2=0b rec3=004
        [0x0a] rec0=19 rec1=00 rec2=17 rec3=036
        [0x0b] rec0=17 rec1=00 rec2=07 rec3=032
        [0x0c] rec0=1a rec1=00 rec2=08 rec3=03a
        [0x0d] rec0=15 rec1=00 rec2=12 rec3=00c
        [0x0e] rec0=1c rec1=00 rec2=18 rec3=038
        [0x0f] rec0=18 rec1=00 rec2=02 rec3=014
        [0x10] rec0=1a rec1=00 rec2=14 rec3=03c
        [0x11] rec0=18 rec1=00 rec2=0c rec3=000
        [0x12] rec0=18 rec1=00 rec2=0c rec3=000
        [0x13] rec0=08 rec1=00 rec2=13 rec3=000
        [0x14] rec0=18 rec1=00 rec2=02 rec3=034
        [0x15] rec0=15 rec1=00 rec2=0d rec3=07c
        [0x16] rec0=06 rec1=00 rec2=06 rec3=000
        [0x17] rec0=09 rec1=00 rec2=06 rec3=000
        [0x18] rec0=08 rec1=00 rec2=14 rec3=000
        [0x19] rec0=1a rec1=00 rec2=0e rec3=066
        [0x1a] rec0=10 rec1=00 rec2=14 rec3=000
        [0x1b] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21756f9e68778489c5419 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 03 00 5c 80 21 20 20 20 20 20 20 20 20 20 20  ┆   \ !          ┆
  0x3: 0000  00 0d 00 57 80 1c 20 20 20 20 20 20 20 72 65 74  ┆   W         ret┆
  0xd: 0000  00 0f 01 3f 80 47 20 20 20 20 20 20 20 50 6f 73  ┆   ? G       Pos┆
  0xf: 0000  00 16 03 fc 80 1d 20 20 20 20 20 20 20 20 20 20  ┆                ┆
  0x16: 0000  00 15 03 fc 00 1a 20 20 20 20 20 20 20 20 20 20  ┆                ┆
  0x15: 0000  00 09 03 f9 80 22 20 20 20 20 20 20 20 20 20 20  ┆     "          ┆
  0x9: 0000  00 19 03 fc 80 0a 52 65 67 5f 54 65 6d 70 6f 2c  ┆      Reg_Tempo,┆
  0x19: 0000  00 1a 03 fc 80 0a 75 5f 52 65 67 69 73 74 72 65  ┆      u_Registre┆
  0x1a: 0000  00 11 03 fc 80 1c 2a 2a 2a 2a 2a 2a 2a 2a 2a 2a  ┆      **********┆
  0x11: 0000  00 00 00 05 80 02 2a 2a 02 63 74 65 75 72 5f 49  ┆      ** cteur_I┆