DataMuseum.dk

top - download

    Length: 3650 (0xe42)
    Types: TextFile
    Names: »B«

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

package body Binaire is


    -- PROCEDURES INTERNES ----------------------------------

    procedure Add_Bit_C (Bit_1 : in out Boolean;
                         Bit_2 :        Boolean;
                         Carry : in out Boolean);




    ---------------------------------------------------------
    -- INTERFACE
    ---------------------------------------------------------

    function Convert_Bit (La_Valeur : Natural) return Val_Binaire is

        Bit_Resultat       : Val_Binaire;
        Valeur_A_Convertir : Natural := La_Valeur;

    begin  
        for I in Bit_Resultat'Range loop
            Bit_Resultat (I)   := (Valeur_A_Convertir mod 2) = 1;
            Valeur_A_Convertir := Valeur_A_Convertir / 2;
        end loop;
        return Bit_Resultat;

    end Convert_Bit;


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


    function Convert_Val (La_Valeur_Binaire : Val_Binaire) return Natural is
        Resultat : Natural := 0;
    begin
        for I in La_Valeur_Binaire'Range loop
            if La_Valeur_Binaire (I) then
                Resultat := Resultat + 2 ** I;
            end if;
        end loop;
        return Resultat;
    end Convert_Val;


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

    procedure Add_H_V_C (La_Valeur_Binaire_1 : in out Val_Binaire;
                         La_Valeur_Binaire_2 :        Val_Binaire;
                         H, V                : out    Boolean;
                         C                   : in out Boolean) is

        Avant_Derniere_Retenue : Boolean;
    begin

        for I in La_Valeur_Binaire_1'Range loop

            Add_Bit_C (Bit_1 => La_Valeur_Binaire_1 (I),
                       Bit_2 => La_Valeur_Binaire_2 (I),
                       Carry => C);

            if I = (La_Valeur_Binaire_1'Last - 4) then
                H := C;
            elsif I = (La_Valeur_Binaire_1'Last - 1) then
                Avant_Derniere_Retenue := C;
            end if;

        end loop;  
        V := Avant_Derniere_Retenue xor C;
    end Add_H_V_C;


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

    procedure Positionne_Flag
                 (La_Valeur_Binaire : Val_Binaire; S, Z, P : out Boolean) is

        Nb_De_Bit_A_1 : Natural := 0;

    begin  
        for I in La_Valeur_Binaire'Range loop
            if La_Valeur_Binaire (I) then
                Nb_De_Bit_A_1 := Nb_De_Bit_A_1 + 1;
            end if;
        end loop;

        S := La_Valeur_Binaire (La_Valeur_Binaire'Last);
        Z := Nb_De_Bit_A_1 = 0;
        P := (Nb_De_Bit_A_1 mod 2) = 0;   -- Parite paire
    end Positionne_Flag;


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

    procedure Positionne_Flag
                 (La_Valeur_Binaire : Val_Binaire; S, Z : out Boolean) is

        P : Boolean;

    begin

        Positionne_Flag (La_Valeur_Binaire, S, Z, P);

    end Positionne_Flag;




    ---------------------------------------------------------
    -- PROCEDURES INTERNES
    ---------------------------------------------------------


    procedure Add_Bit_C (Bit_1 : in out Boolean;
                         Bit_2 :        Boolean;
                         Carry : in out Boolean) is
        -- ajoute 2 bits entre eux en tenant compte et en modifiant la carry
        -- passee en parametre
    begin

        case Carry is
            when False =>
                Carry := Bit_1 and Bit_2;
                Bit_1 := Bit_1 xor Bit_2;
            when True =>
                Carry := Bit_1 or Bit_2;
                Bit_1 := not (Bit_1 xor Bit_2);  
        end case;
    end Add_Bit_C;




end Binaire;