---MH---------------------------------------------------------------------------
-- Das Urheberrecht dieses Dokumentes verbleibt jederzeit der Siemens Schweiz AG.
-- Ohne deren schriftliche Einwilligung darf es nicht vervielfaeltigt oder dritten
-- Personen, auch nicht in abgeaenderter Form, ganz oder teilweise mitgeteilt,
-- zugaenglich oder nutzbar gemacht werden. Es ist Fabrikations- und
-- Geschaeftsgeheimnis im Sinne von OR 192 und StGB 273.
-- 
-- Filename    : ilss_hex_dump.adb
-- Version     : \main\4
-- 
-- Location    : \ILTIS\Cell\ilss\src\
-- Creation    : 10-Aug-99 17:43  GAU
-- Description : Memory-Bereich als Hex-Dump ausgeben.
-- 
-- \main branch:
--    4  09-Feb-09 06:11  chakuhm0  CMS-History durch ClearCase-History ersetzt
--    3  18-Aug-08 14:30  LEP       FR#00011361: VMS-Preprozessor-Anweisungen entfernen
--    2  22-Jun-05 15:00  GAU       FR#2901: um weitere Darstellungsmoeglichkeiten erweitert.
--    1  10-Aug-99 17:43  GAU       Memory-Bereich als Hex-Dump ausgeben.
---END--------------------------------------------------------------------------

with Unchecked_Conversion;

--         ******************************
--         *
-- BODY    *    ILSS_Hex_Dump
--         *
--         ******************************
procedure ILSS_Hex_Dump (Start_Address  : in System.ADDRESS;
                         Length         : in NATURAL;
                         Address_Offset : in INTEGER := 0;
                         Align_Mod_16   : in BOOLEAN := TRUE) is
--!
--! Notes
--!   none
--!

   type T_ADDRESS is mod 2**32;
   for  T_ADDRESS'size use 32;

   function To_Addr is new Unchecked_Conversion(System.ADDRESS, T_ADDRESS);
   function To_Addr is new Unchecked_Conversion(INTEGER,        T_ADDRESS);

   type T_DIGIT is range 0 .. 15;

   type T_BYTE is record
      L : T_DIGIT;
      H : T_DIGIT;
   end record;
   for T_BYTE use record
      L at 0 range 0 .. 3;
      H at 0 range 4 .. 7;
   end record;
   for T_BYTE'size use 8;

   type T_ADDRESS_BYTES is record -- LSB-first
      d : T_BYTE;
      c : T_BYTE;
      b : T_BYTE;
      a : T_BYTE;
   end record;
   pragma PACK(T_ADDRESS_BYTES);

   -- "aaaaaaaa  00 01 02 03 04 05 06 07  08 09 0A 0B 0C 0D 0E 0F  01234567 89ABCDEF"
   --  +-1       +-11                     +-27                     +-61     +-70   +-77
   subtype T_DUMP_STR is STRING(1 .. 77);

   A       : T_ADDRESS := To_Addr(Address_Offset);
   A_Bytes : T_ADDRESS_BYTES;
   for A_Bytes use at A'address;

   type T_ARRAY is array(0 .. 2_147_483_646) of T_BYTE;
   D : T_ARRAY;
   for D use at Start_Address;

   H    : T_DUMP_STR;
   N    : NATURAL := 0;
   Last : NATURAL;
   Skip : NATURAL := 0;

   procedure Put_Byte(B        : in T_BYTE;
                      Hex_Pos  : in POSITIVE;
                      Char_Pos : in NATURAL) is
      type T_SYMB_ARRAY is array(T_DIGIT) of CHARACTER;
      C_Hex_Symb : constant T_SYMB_ARRAY := "0123456789ABCDEF";
      function To_Char is new Unchecked_Conversion(T_BYTE, CHARACTER);
   begin
      H(Hex_Pos    ) := C_Hex_Symb(B.H);
      H(Hex_Pos + 1) := C_Hex_Symb(B.L);
      if Char_Pos > 0 then
         if To_Char(B) in ' ' .. '~' then
            H(Char_Pos) := To_Char(B);
         else
            H(Char_Pos) := '.';
         end if;
      end if;
   end Put_Byte;

begin
   if Length = 0 then
      return;
   end if;

   if Align_Mod_16 then
      Skip := NATURAL(A mod 16);
   end if;

   while N < Length loop
      H := (others => ' ');
      Put_Byte(A_Bytes.a, 1,0);
      Put_Byte(A_Bytes.b, 3,0);
      Put_Byte(A_Bytes.c, 5,0);
      Put_Byte(A_Bytes.d, 7,0);
      for i in Skip .. 15 loop
         exit when N >= Length;
         Last :=        61 + i   + i/8;
         Put_Byte(D(N), 11 + i*3 + i/8, Last);
         A := A + 1;
         N := N + 1;
      end loop;
      Skip := 0;
      Put_Line(H(1 .. Last));
   end loop;
end ILSS_Hex_Dump;
