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

⟦e37b37245⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, procedure Exe_001, seg_00554f

Derivation

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

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", "nd");  
    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;  

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=28 rec1=00 rec2=01 rec3=03a
        [0x01] rec0=1f rec1=00 rec2=02 rec3=05a
        [0x02] rec0=24 rec1=00 rec2=03 rec3=00a
        [0x03] rec0=22 rec1=00 rec2=04 rec3=086
        [0x04] rec0=00 rec1=00 rec2=07 rec3=002
        [0x05] rec0=12 rec1=00 rec2=05 rec3=03e
        [0x06] rec0=19 rec1=00 rec2=06 rec3=000
    tail 0x217009a9881978ba3deef 0x42a00088462063203