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

⟦aa608af75⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Bit_Operations, seg_014206

Derivation

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

with Unchecked_Conversion;

package body Generic_Bit_Operations is
    pragma Suppress (Division_Check);
    pragma Suppress (Index_Check);
    pragma Suppress (Overflow_Check);
    pragma Suppress (Range_Check);
    type Booleans is
       array (Integer range 0 .. Integer_Type'Size - 1) of Boolean;
    pragma Pack (Booleans);

    Clear_Sign_Bit : Integer_Type :=
       Integer_Type'Last / 2 - Integer_Type'First / 2;
    Shift_Right_Sign_Bit : Integer_Type := Clear_Sign_Bit - Clear_Sign_Bit / 2;
    -- Masks used to clear the sign bit and to shift it to the right

    First_Bit : Integer;     -- Offset of the first bit within integer_type

    function Bits is new Unchecked_Conversion (Integer_Type, Booleans);
    function Int is new Unchecked_Conversion (Booleans, Integer_Type);

    function Get_First_Bit_Location return Integer is  
        Quotient : Integer := 0;
        Number : Integer_Type := Clear_Sign_Bit;
        -- Abs max that can be held in integer_type
        First_Bit_Location : Integer := 0;
    begin  
        while Number /= 0 loop
            Number := Number / 2;  
            Quotient := Quotient + 1;
        end loop;  
        First_Bit_Location := Integer_Type'Size - Quotient - 1;
        -- Offset at which the first bit starts
        return First_Bit_Location;
    end Get_First_Bit_Location;

    function Mask (Start, Length : Natural) return Booleans is
        M : Booleans := (others => False);
    begin
        for I in 0 .. Length - 1 loop -- just to see
            M (I + Start + First_Bit) := True;
        end loop;  
        return M;
    end Mask;

    function Extract (W : Integer_Type; Start : Natural; Length : Natural)
                     return Integer_Type is
    begin
        return Int (Bits (W) and Mask (Start, Length));
    end Extract;

    function Test_Bit (W : Integer_Type; B : Natural) return Boolean is
    begin
        return Bits (W) (B + First_Bit);
    end Test_Bit;

    function Insert (W, Into : Integer_Type; Start : Natural; Length : Natural)
                    return Integer_Type is
    begin
        return Int ((Bits (Into) and not Mask (Start, Length)) or
                    Bits (Logical_Shift
                             (Extract (W, Booleans'Last - Length + 1, Length),
                              (Booleans'Last - Length + 1) - Start)));
    end Insert;

    procedure Set_Bit_To_One (W : in out Integer_Type; B : Natural) is
        X : Booleans := Bits (W);
    begin  
        X (B + First_Bit) := True;
        W := Int (X);
    end Set_Bit_To_One;

    procedure Set_Bit_To_Zero (W : in out Integer_Type; B : Natural) is
        X : Booleans := Bits (W);
    begin
        X (B + First_Bit) := False;
        W := Int (X);
    end Set_Bit_To_Zero;

    function Logical_And (X, Y : Integer_Type) return Integer_Type is
    begin
        return Int (Bits (X) and Bits (Y));
    end Logical_And;

    function Logical_Or (X, Y : Integer_Type) return Integer_Type is
    begin
        return Int (Bits (X) or Bits (Y));
    end Logical_Or;

    function Logical_Xor (X, Y : Integer_Type) return Integer_Type is
    begin
        return Int (Bits (X) xor Bits (Y));
    end Logical_Xor;

    function Logical_Not (X : Integer_Type) return Integer_Type is
    begin
        return Int (not Bits (X));
    end Logical_Not;

    function Logical_Shift
                (X : Integer_Type; Amount : Integer) return Integer_Type is
        W : Integer_Type := X;  
        Shift_Amount : Integer := Amount;
    begin
        if Shift_Amount > 0 then -- shift left
            for I in 1 .. Shift_Amount loop
                W := W * 2;
            end loop;
        elsif Shift_Amount < 0 then  
            if W < 0 then
                W := Logical_Or (Logical_And (W, Clear_Sign_Bit) / 2,
                                 Shift_Right_Sign_Bit);
                Shift_Amount := Shift_Amount + 1;
                -- Perform one logical shift
            end if;  
            if Shift_Amount < 0 then
                for I in 1 .. -Shift_Amount loop
                    W := W / 2;
                end loop;
                -- Perform the remaining logical shifts
            end if;
        end if;
        return W;
    end Logical_Shift;  
begin
    First_Bit := Get_First_Bit_Location;
end Generic_Bit_Operations;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=1a rec1=00 rec2=01 rec3=044
        [0x01] rec0=1d rec1=00 rec2=02 rec3=036
        [0x02] rec0=1c rec1=00 rec2=03 rec3=056
        [0x03] rec0=1e rec1=00 rec2=04 rec3=066
        [0x04] rec0=10 rec1=00 rec2=05 rec3=000
    tail 0x2150ef39483127f498b2d 0x42a00088462060003