DataMuseum.dk

top - download

    Length: 4321 (0x10e1)
    Types: TextFile
    Names: »B«

└─⟦5829e5ed5⟧ Bits:30000534 8mm tape, Rational 1000, RCI 2_0_5
    └─ ⟦c9a165082⟧ »DATA« 
        └─⟦2162db02b⟧ 
            └─⟦this⟧ 

TextFile

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;