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

⟦d85fddf30⟧ TextFile

    Length: 5391 (0x150f)
    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 Binaire;
with Registres;
with Z80_Defs;

package body Alu_16_Bit is


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


    package Bin_8 is new Binaire (Nb_De_Bit => 8);
    subtype T_Bit_Octet is Bin_8.Val_Binaire;
    use Bin_8;



    package Bin_16 is new Binaire (Nb_De_Bit => 16);
    subtype T_Bit_Mot is Bin_16.Val_Binaire;
    use Bin_16;



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

    procedure Add_F;
    procedure Adc_F;
    procedure Sbc_F;
    procedure Inc_F;
    procedure Dec_F;

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

    Mot_Bit_1, Mot_Bit_2 : T_Bit_Mot;
    Flag : T_Bit_Octet;

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


    function Executer (Operation : T_Operation) return Mot.T_Mot is

        use Registres;
    begin

        Flag := Convert_Bit (Lire_Simple (Le_Registre => Z80_Defs.F));

        case Operation is
            when Desassembleur.Inc =>
                Inc_F;
            when Desassembleur.Dec =>
                Dec_F;
            when Desassembleur.Add =>
                Add_F;
            when Desassembleur.Adc =>
                Adc_F;
            when Desassembleur.Sbc =>
                Sbc_F;
        end case;

        Ecrire_Simple (Le_Registre => Z80_Defs.F,
                       Un_Octet => Convert_Val (Flag));

        return Convert_Val (La_Valeur_Binaire => Mot_Bit_1);

    end Executer;


    procedure Fournir_Operande_1 (Op_1 : Mot.T_Mot) is
    begin
        Mot_Bit_1 := Convert_Bit (La_Valeur => Op_1);
    end Fournir_Operande_1;


    procedure Fournir_Operande_2 (Op_2 : Mot.T_Mot) is
    begin
        Mot_Bit_2 := Convert_Bit (La_Valeur => Op_2);
    end Fournir_Operande_2;



    --------------------------------------------------
    -- PROCEDURES INTERNES (privees)
    --------------------------------------------------


    procedure Adc (Le_Bit_Mot_1 : in out T_Bit_Mot;
                   Le_Bit_Mot_2 : T_Bit_Mot;
                   C : in out Boolean) is
        H, V : Boolean;
    begin
        Add_H_V_C (Le_Bit_Mot_1, Le_Bit_Mot_2, H, V, C);
    end Adc;


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

    procedure Add (Le_Bit_Mot_1 : in out T_Bit_Mot; Le_Bit_Mot_2 : T_Bit_Mot) is
        H, V : Boolean;
        C : Boolean := False;
    begin

        Add_H_V_C (Le_Bit_Mot_1, Le_Bit_Mot_2, H, V, C);

    end Add;

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

    procedure Inc (Le_Bit_Mot : in out T_Bit_Mot) is
        Un : T_Bit_Mot := (True, False, False, False, False, False,
                           False, False, False, False, False,
                           False, False, False, False, False);
    begin
        Add (Le_Bit_Mot, Un);
    end Inc;

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

    procedure Dec (Le_Bit_Mot : in out T_Bit_Mot) is
        Moins_Un : T_Bit_Mot := (others => True);
    begin
        Add (Le_Bit_Mot, Moins_Un);
    end Dec;

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

    procedure Sbc (Le_Bit_Mot_1 : in out T_Bit_Mot;
                   Le_Bit_Mot_2 : T_Bit_Mot;
                   C : in out Boolean;
                   V : out Boolean) is
        Le_Bit_Mot : T_Bit_Mot := Le_Bit_Mot_2;
        Zero : T_Bit_Mot := (others => False);
        H : Boolean;
    begin

        Adc (Le_Bit_Mot, Zero, C);
        Le_Bit_Mot := not Le_Bit_Mot;
        Inc (Le_Bit_Mot);
        C := False;
        Add_H_V_C (Le_Bit_Mot_1, Le_Bit_Mot, H, V, C);
        C := not C;

    end Sbc;





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

    procedure Positionne_Flag_S_Z is
    begin

        Positionne_Flag (Mot_Bit_1, S => Flag (7), Z => Flag (6));

    end Positionne_Flag_S_Z;

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

    procedure Add_F is

        C : Boolean := False;  
        V : Boolean;
    begin

        Add_H_V_C (Mot_Bit_1, Mot_Bit_2, H => Flag (4), V => V, C => C);

        ----------------------- Half Carry modifiee
        Flag (1) := False;   -- N = 0
        Flag (0) := C;       -- Carry modifiee

    end Add_F;


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

    procedure Adc_F is

    begin

        Add_H_V_C (Mot_Bit_1, Mot_Bit_2,
                   H => Flag (4),
                   V => Flag (2),
                   C => Flag (0));

        ------------------------- Carry ,Half Carry et Overflow modifies
        Flag (1) := False;     -- N = 0
        Positionne_Flag_S_Z;   -- S et Z modifies

    end Adc_F;

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

    procedure Sbc_F is

    begin
        Sbc (Mot_Bit_1, Mot_Bit_2, C => Flag (0), V => Flag (2));

        -------------------------- Carry et Overflow modifies
        Flag (1) := True;       -- N = 1
        Positionne_Flag_S_Z;    -- S et Z modifoes

    end Sbc_F;

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

    procedure Inc_F is
    begin  
        Inc (Mot_Bit_1);           -- Aucun flag de modifie
    end Inc_F;

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

    procedure Dec_F is
    begin  
        Dec (Mot_Bit_1);           -- Aucun flag de modifie
    end Dec_F;

end Alu_16_Bit;