DataMuseum.dk

top - download

    Length: 5094 (0x13e6)
    Types: TextFile
    Names: »B«

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦49e7f20b9⟧ 
                └─⟦this⟧ 

TextFile

with Test_Io;  
use Test_Io;  
with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;

procedure Exe_001 is

    procedure Put (A     : S_Long;  
                   Op    : String;  
                   B     : S_Long;  
                   C     : S_Long;  
                   Width : Natural) is  
    begin  
        Hex (A, Width => Width);  
        Put (' ');  
        Put (Op);  
        Put (' ');  
        Hex (B, Width => Width);  
        Put (" => ");  
        Hex (C, Width => Width);  
        New_Line;  
    end Put;

    procedure Put (Op    : String;  
                   B     : S_Long;  
                   C     : S_Long;  
                   Width : Natural) is  
    begin  
        Put (Op);  
        Put (' ');  
        Hex (B, Width => Width);  
        Put (" => ");  
        Hex (C, Width => Width);  
        New_Line;  
    end Put;

    generic  
        type Numeric is range <>;  
        Bits : in Positive;  
        Name : in String;  
        with function Oper (A, B : Numeric) return Numeric;  
    procedure Logical_Test;

    procedure Logical_Test is

        procedure One (A, B : Numeric) is  
        begin  
            Put (S_Long (A), Name, S_Long (B),  
                 S_Long (Oper (A, B)), 4 + Bits / 4);  
        end One;

    begin

        One (Numeric'First, Numeric'Last);  
        One (Numeric'Last, Numeric'First);  
        One (Numeric'First, 1);  
        One (1, Numeric'First);  
        One (Numeric'Last, 1);  
        One (1, Numeric'Last);  
        One (16#F#, 16#1#);  
        One (16#1#, 16#F#);  
        One (16#F#, 16#0#);  
        One (16#0#, 16#F#);  
        One (16#D#, 16#1#);  
        One (16#1#, 16#D#);  
        One (16#D#, 16#0#);  
        One (16#0#, 16#D#);  
        for I in Integer range 0 .. Bits - 2 loop  
            One (Numeric'Last, Numeric (2 ** I));  
            One (Numeric (2 ** I), Numeric'Last);  
            One ((2 ** (Bits / 3) - 1) * 2 ** (Bits / 3), Numeric (2 ** I));  
            One (Numeric (2 ** I), (2 ** (Bits / 3) - 1) * 2 ** (Bits / 3));  
        end loop;

    end Logical_Test;

    generic  
        type Numeric is range <>;  
        Bits : in Positive;  
        Name : in String;  
        with function Oper (A : Numeric) return Numeric;  
    procedure Unary_Test;

    procedure Unary_Test is

        procedure One (A : Numeric) is  
        begin  
            Put (Name, S_Long (A), S_Long (Oper (A)), 4 + Bits / 4);  
        end One;

    begin

        One (Numeric'First);  
        One (Numeric'Last);  
        One (1);  
        One (2);  
        One (3);  
        One (16#F#);  
        One (16#0#);  
        One (16#D#);  
        One ((2 ** (Bits / 3) - 1) * 2 ** (Bits / 3));  
        for I in Integer range 0 .. Bits - 2 loop  
            One (Numeric (2 ** I));  
        end loop;

    end Unary_Test;

    generic  
        type Numeric is range <>;  
        Bits : in Positive;  
        Name : in String := "shift";  
        with function Shift (A : Numeric; B : Integer) return Numeric is <>;  
    procedure Shift_Test;

    procedure Shift_Test is

        procedure One (A : Numeric; B : Integer) is  
        begin  
            Put (S_Long (A), Name, S_Long (B),  
                 S_Long (Shift (A, B)), 4 + Bits / 4);  
        end One;

    begin

        for I in Integer range 0 .. Bits loop  
            One (Numeric'First, I);  
            One (Numeric'First, -I);  
            One (Numeric'Last, I);  
            One (Numeric'Last, -I);  
            One (0, I);  
            One (0, -I);  
            One (1, I);  
            One (1, -I);  
            One (16#F#, I);  
            One (16#F#, -I);  
        end loop;

    end Shift_Test;

    procedure And_S_Long  is new Logical_Test (S_Long, 32, "and", "and");  
    procedure And_U_Short is new Logical_Test (U_Short, 16, "and", "and");  
    procedure And_U_Char  is new Logical_Test (U_Char, 8, "and", "and");

    procedure Or_S_Long  is new Logical_Test (S_Long, 32, "or", "or");  
    procedure Or_U_Short is new Logical_Test (U_Short, 16, "or", "or");  
    procedure Or_U_Char  is new Logical_Test (U_Char, 8, "or", "or");

    procedure Xor_S_Long  is new Logical_Test (S_Long, 32, "xor", "xor");  
    procedure Xor_U_Short is new Logical_Test (U_Short, 16, "xor", "xor");  
    procedure Xor_U_Char  is new Logical_Test (U_Char, 8, "xor", "xor");

    procedure Not_S_Long  is new Unary_Test (S_Long, 32, "not", "not");  
    procedure Not_U_Short is new Unary_Test (U_Short, 16, "not", "not");  
    procedure Not_U_Char  is new Unary_Test (U_Char, 8, "not", "not");

    procedure Shift_S_Long  is new Shift_Test (S_Long, 32);  
    procedure Shift_U_Short is new Shift_Test (U_Short, 16);  
    procedure Shift_U_Char  is new Shift_Test (U_Char, 8);

begin

    And_S_Long;  
    And_U_Short;  
    And_U_Char;

    Or_S_Long;  
    Or_U_Short;  
    Or_U_Char;

    Xor_S_Long;  
    Xor_U_Short;  
    Xor_U_Char;

    Not_S_Long;  
    Not_U_Short;  
    Not_U_Char;

    Shift_S_Long;  
    Shift_U_Short;  
    Shift_U_Char;

end Exe_001;