DataMuseum.dk

top - metrics - download

    Length: 6104 (0x17d8)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Machine_Code;

package body Crc is

    type Checksum_Set is array (0 .. 7) of Checksum;
    -- Checksum_Set (I) is the zero-preset CRC for D = (2 ** I).
    -- Checksum_Set (0..7) correspond to M8..M1 in Marton & Frambs.

    type Checksum_Table is array (Byte) of Checksum;
    -- Checksum_Table (D) is the zero-preset CRC for D.

    Reverse_One : constant Byte := 128;
    One : constant Checksum := (Msb => 0, Lsb => Reverse_One);

    function "xor" (X, Y : Byte) return Byte is
        use Machine_Code;
    begin
        Instruction'(Load_Top, -3); -- Y
        pragma Cg_Directive ("Outline_Only");
        Instruction'(Load_Top, -3); -- X
        pragma Cg_Directive ("Outline_Only");
        Instruction'(Execute, (Discrete_Class, Xor_Op)); -- Here's the beef
        Instruction'(Exit_Subprogram,
                     New_Top_Offset => 2,  -- number of parameters
                     Exit_Options => (With_Result => True,
                                      From_Utility => False));
        pragma Cg_Directive ("Outline_Only");
    end "xor";
    -- pragma inline ("xor"); not supported

    function Lsbit (X : Byte) return Boolean is
        use Byte_Defs;
    begin
        return (X mod 2) /= 0;
    end Lsbit;

    function Shift_Right (X : Byte) return Byte is
        use Byte_Defs;
    begin
        return X / 2;
    end Shift_Right;

    -- NOTE: checksum bits are stored in transmission order,
    -- which is bit-reversed relative to ordinary bytes.
    -- Hence the bit ordering of the following operations:

    function Msbit (X : Checksum) return Boolean is
    begin
        return Lsbit (X (Msb));
    end Msbit;

    function Shift_Left (X : Checksum) return Checksum is
        use Byte_Defs;
    begin
        if Lsbit (X (Lsb)) then
            return (Msb => Shift_Right (X (Msb)) + Reverse_One,
                    Lsb => Shift_Right (X (Lsb)));
        else
            return (Msb => Shift_Right (X (Msb)), Lsb => Shift_Right (X (Lsb)));
        end if;
    end Shift_Left;

    -- That's all for bit-ordering.
    -- Subsequent operations use the preceding primitives.

    function "xor" (X, Y : Checksum) return Checksum is
    begin
        return (Msb => (X (Msb) xor Y (Msb)), Lsb => (X (Lsb) xor Y (Lsb)));
    end "xor";

    function "not" (X : Checksum) return Checksum is
    begin
        return X xor All_1;
    end "not";

    function Msbit (X : Natural) return Boolean is
    begin
        return ((X / (2 ** 15)) mod 2) /= 0;
    end Msbit;

    function Shift_Left (X : Natural) return Natural is
    begin
        return (X mod (2 ** 15)) * 2;
    end Shift_Left;

    function Image (X : Checksum) return String is
        C : Checksum := X;
        S : String (1 .. 16) := (others => '0');
    begin
        for I in S'Range loop
            if Msbit (C) then
                S (I) := '1';
            end if;
            C := Shift_Left (C);
        end loop;
        return " 2#" & S (1 .. 4) & '_' & S (5 .. 8) & '_' &
                  S (9 .. 12) & '_' & S (13 .. 16) & "#";
    end Image;

    function Convert (X : Checksum) return Natural is
        C : Checksum := X;
        N : Natural := 0;
    begin
        for Bit in reverse 0 .. 15 loop
            N := Shift_Left (N);
            if Msbit (C) then
                N := N + 1;
            end if;
            C := Shift_Left (C);
        end loop;
        return N;
    end Convert;

    function Convert (X : Natural) return Checksum is
        N : Natural := X;
        C : Checksum := All_0;
    begin
        for Bit in reverse 0 .. 15 loop
            C := Shift_Left (C);
            if Msbit (N) then
                C := C xor One;
            end if;
            N := Shift_Left (N);
        end loop;
        return C;
    end Convert;

    function To_Checksum (Generator : Polynomial) return Checksum is
        -- Pack a polynomial into a checksum, one element per bit.
        Answer : Checksum := All_0;
    begin
        for I in reverse 0 .. 15 loop
            Answer := Shift_Left (Answer);
            if Generator (I) then
                Answer := Answer xor One;
            end if;
        end loop;
        return Answer;
    end To_Checksum;

    function To_Set (Generator : Polynomial) return Checksum_Set is
        P : constant Checksum := To_Checksum (Generator);
        M : Checksum_Set;
    begin
        M (7) := P;
        for I in reverse 0 .. 6 loop
            if Msbit (M (I + 1)) then
                M (I) := Shift_Left (M (I + 1)) xor P;
            else
                M (I) := Shift_Left (M (I + 1));
            end if;
        end loop;
        return M;
    end To_Set;

    function To_Table (Generator : Polynomial) return Checksum_Table is
        M : constant Checksum_Set := To_Set (Generator);
        Table : Checksum_Table;
    begin
        for A in Byte loop
            declare
                A_T : Byte := A;
                M_T : Checksum := All_0;
            begin
                for Bit in 0 .. 7 loop
                    if Lsbit (A_T) then
                        M_T := M_T xor M (Bit);
                    end if;
                    A_T := Shift_Right (A_T);
                end loop;
                Table (A) := M_T;
            end;
        end loop;
        for I in M'Range loop
            pragma Assert (M (I) = Table (Byte (Integer (2) ** I)));
            null;
        end loop;
        return Table;
    end To_Table;

    package body Accumulator is

        Table : Checksum_Table := To_Table (Generator);

        procedure Accumulate (R : in out Checksum; D : Byte) is
            M : Checksum;
        begin
            M := Table (D xor R (Msb));
            R := (Msb => (M (Msb) xor R (Lsb)), Lsb => (M (Lsb)));
        end Accumulate;

        procedure Accumulate (R : in out Checksum; D : Byte_String) is
            M : Checksum;
        begin
            for I in D'Range loop
                M := Table (D (I) xor R (Msb));
                R := (Msb => (M (Msb) xor R (Lsb)), Lsb => (M (Lsb)));
            end loop;
        end Accumulate;

    end Accumulator;

end Crc;