⟦f69f6ef86⟧

E3 Source Code



--
-- This package contains some functions for converting binary values to
-- ascii hex (so they can be printed in hex) and for converting hex to
-- ascii.
--
with Unsigned_Types;
with Unchecked_Conversion;
with V_I_Bits;
package body Hex is

    -- number of hex digits in an integer
    Hex_Digits : constant Integer := Integer'Size / 4;

    subtype Nibble is Integer range 0 .. 15;

    -- mapping of nibbles to character representation, normal and complement
    Int_To_Char_Pos : constant array (Nibble) of Character :=
       "0123456789ABCDEF";
    Int_To_Char_Neg : constant array (Nibble) of Character :=
       "FEDCBA9876543210";

    -- mapping of hex digits to values
    function Char_To_Int_Pos (C : Character) return Integer is
    begin
        case C is
            when 'a' .. 'f' =>
                return Character'Pos (C) - Character'Pos ('a') + 10;
            when 'A' .. 'F' =>
                return Character'Pos (C) - Character'Pos ('A') + 10;
            when '0' .. '9' =>
                return Character'Pos (C) - Character'Pos ('0');
            when others =>
                raise Constraint_Error;
        end case;
    end Char_To_Int_Pos;

    function To_Unsigned_Integer is
       new Unchecked_Conversion (Integer, Unsigned_Types.Unsigned_Integer);


    function Hex_To_Integer (Str : String) return Integer is
        First : Integer := Str'First;
        Last : Integer := Str'Last;
        Result : Integer := 0;
    begin
        -- strip off trailing blanks
        while First < Last and Str (Last) = ' ' loop
            Last := Last - 1;
        end loop;

        -- strip off leading blanks
        while First < Last and then Str (First) = ' ' loop
            First := First + 1;
        end loop;

        -- strip off leading 0s
        while First < Last and then Str (First) = '0' loop
            First := First + 1;
        end loop;

        if Last - First + 1 > Hex_Digits then
            raise Constraint_Error;  -- number too long
        end if;

        if Last - First + 1 < Hex_Digits or else Str (First) in '0' .. '7' then
            for I in First .. Last loop
                Result := 16 * Result + Nibble (Char_To_Int_Pos (Str (I)));
            end loop;
        else
            -- str >= 80000000, so result is negative
            for I in First .. Last loop
                Result := 16 * Result + Nibble (15 - Char_To_Int_Pos (Str (I)));
            end loop;
            Result := -Result - 1;
        end if;

        return Result;
    end Hex_To_Integer;


    function Unsigned_To_Hex (Uint : Unsigned_Types.Unsigned_Integer;
                              Width : Integer := 0;
                              Fill : Character := ' ') return String is
        use Unsigned_Types;

        U16 : constant Unsigned_Integer := 16;
        U0 : constant Unsigned_Integer := 0;

        Result : String (1 .. Hex_Digits);
        Val : Unsigned_Integer;
        Start : Integer;
        J : Integer := Hex_Digits;
        Blanks : constant String (1 .. Width - Hex_Digits) := (others => Fill);
    begin
        Val := Uint;
        loop
            Result (J) := Int_To_Char_Pos
                             (V_I_Bits.Bit_And (Integer (Val), 16#0F#));
            Val := Unsigned_Integer (V_I_Bits.Bit_Srl (Integer (Val), 4));
            exit when Val = U0;
            J := J - 1;
        end loop;
        if Width > Hex_Digits then
            Start := 1;
        elsif Width <= 0 then
            Start := J;
        else
            Start := Hex_Digits - Width + 1;
        end if;
        while J > Start loop
            J := J - 1;
            Result (J) := Fill;
        end loop;
        --
        -- blanks is usually a null string (for width <= HEX_DIGITS);
        --
        return Blanks & Result (Start .. Hex_Digits);
    end Unsigned_To_Hex;


    -- width specifies the minimum width of the result string.  If it needs
    -- to be widened it is padded on the left with fill.
    function Integer_To_Hex
                (Int : Integer; Width : Integer := 0; Fill : Character := ' ')
                return String is
        use Unsigned_Types;
    begin
        return Unsigned_To_Hex (To_Unsigned_Integer (Int), Width, Fill);
    end Integer_To_Hex;


    function Word_To_Hex (W : Machine_Types.Word; Fill : Character := ' ')
                         return String is
    begin
        return Integer_To_Hex (Integer (W), 4, Fill);
    end Word_To_Hex;


    function Byte_To_Hex (B : Machine_Types.Byte; Fill : Character := ' ')
                         return String is
    begin
        return Integer_To_Hex (Integer (B), 2, Fill);
    end Byte_To_Hex;

end Hex;
DataMuseum.dk

Rational R1000/400

⟦f69f6ef86⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
