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

⟦c00f2b77b⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Test_Alu_16, seg_00f4f4

Derivation

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

with Text_Io;  
with Mot;  
with Alu_16_Bit;
with Desassembleur;
with Registres;
with Octet;
with Binaire;
with Z80_Defs;

package body Test_Alu_16 is

    package Mot_Io is new Text_Io.Integer_Io (Num => Mot.T_Mot);

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


    function Get_Mot return Mot.T_Mot is  
        Result : Mot.T_Mot;
    begin
        Mot_Io.Get (Result);
        return Result;
    end Get_Mot;


    procedure Put_Mot (Le_Mot : Mot.T_Mot) is
    begin
        Mot_Io.Put (Le_Mot);
    end Put_Mot;

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

    procedure Read_1_Op (Op : in out Mot.T_Mot) is
    begin  
        Text_Io.Put ("op_1>");
        Op := Get_Mot;
        Text_Io.Put_Line ("");
        Alu_16_Bit.Fournir_Operande_1 (Op);

    end Read_1_Op;


    procedure Read_2_Op (Op_1, Op_2 : in out Mot.T_Mot) is
    begin
        Text_Io.Put ("op_1>");
        Op_1 := Get_Mot;
        Text_Io.Put_Line ("");
        Alu_16_Bit.Fournir_Operande_1 (Op_1);

        Text_Io.Put ("op_2>");
        Op_2 := Get_Mot;
        Text_Io.Put_Line ("");
        Alu_16_Bit.Fournir_Operande_2 (Op_2);

    end Read_2_Op;


    procedure Display (Res : Mot.T_Mot) is  
        Flag : T_Bit_Octet;
    begin
        Text_Io.Put_Line ("");
        Text_Io.Put ("res>");
        Put_Mot (Res);
        Text_Io.Put_Line ("");
        Text_Io.Put ("flag>");

        Flag := Convert_Bit (Registres.Lire_Simple (Z80_Defs.F));
        for I in reverse Flag'Range loop
            if Flag (I) then
                Text_Io.Put ("1");
            else
                Text_Io.Put ("0");
            end if;
        end loop;

        Text_Io.Put_Line ("");
        Text_Io.Put_Line ("==================================");
        Text_Io.Put_Line ("");
    end Display;



    procedure Read_Flag is  
        Flag     : Octet.T_Octet := 0;
        Flag_Str : String (1 .. 8);

    begin  
        Text_Io.Put ("flag>");
        Text_Io.Get (Flag_Str);

        for I in reverse 1 .. 8 loop
            if Flag_Str (I) = '1' then
                Flag := Flag + 2 ** (8 - I);
            end if;
        end loop;

        Registres.Ecrire_Simple (Z80_Defs.F, Flag);
    end Read_Flag;


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

    procedure Exec_Inc is  
        Op_1 : Mot.T_Mot;
    begin  
        Read_Flag;
        Read_1_Op (Op_1);
        Display (Alu_16_Bit.Executer (Desassembleur.Inc));  
    end Exec_Inc;

    procedure Exec_Dec is  
        Op_1 : Mot.T_Mot;
    begin
        Read_Flag;
        Read_1_Op (Op_1);
        Display (Alu_16_Bit.Executer (Desassembleur.Dec));  
    end Exec_Dec;

    procedure Exec_Add is  
        Op_1, Op_2 : Mot.T_Mot;
    begin
        Read_Flag;
        Read_2_Op (Op_1, Op_2);
        Display (Alu_16_Bit.Executer (Desassembleur.Add));  
    end Exec_Add;

    procedure Exec_Adc is  
        Op_1, Op_2 : Mot.T_Mot;
    begin  
        Read_Flag;
        Read_2_Op (Op_1, Op_2);
        Display (Alu_16_Bit.Executer (Desassembleur.Adc));  
    end Exec_Adc;

    procedure Exec_Sbc is  
        Op_1, Op_2 : Mot.T_Mot;
    begin  
        Read_Flag;
        Read_2_Op (Op_1, Op_2);
        Display (Alu_16_Bit.Executer (Desassembleur.Sbc));  
    end Exec_Sbc;


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

    function Menu return Character is
        Choix : Character;
    begin
        Text_Io.Put_Line ("1)INC   2)DEC   3)ADD   4)ADC   5)SBC ");
        Text_Io.Put ("choix>");
        Text_Io.Get (Choix);
        Text_Io.Put_Line ("");
        return Choix;
    end Menu;


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

    procedure Test is
        At_End : Boolean := False;
        Choix  : Character;
    begin
        while not At_End loop
            Choix := Menu;
            case Choix is
                when '1' =>
                    Exec_Inc;
                when '2' =>
                    Exec_Dec;
                when '3' =>
                    Exec_Add;
                when '4' =>
                    Exec_Adc;
                when '5' =>
                    Exec_Sbc;
                when others =>
                    At_End := True;
                    Text_Io.Put_Line ("FIN");
            end case;

        end loop;
    end Test;


end Test_Alu_16;

    nblk1=7
    nid=3
    hdr6=c
        [0x00] rec0=2f rec1=00 rec2=01 rec3=006
        [0x01] rec0=26 rec1=00 rec2=06 rec3=020
        [0x02] rec0=15 rec1=00 rec2=07 rec3=032
        [0x03] rec0=28 rec1=00 rec2=02 rec3=00a
        [0x04] rec0=22 rec1=00 rec2=05 rec3=03a
        [0x05] rec0=08 rec1=00 rec2=04 rec3=000
        [0x06] rec0=01 rec1=00 rec2=03 rec3=001
    tail 0x2150b56ca822b50152ea8 0x42a00088462062803
Free Block Chain:
  0x3: 0000  00 00 00 0f 80 09 74 5f 41 6c 75 5f 31 36 3b 09  ┆      t_Alu_16; ┆