File : debug.adb

with Ada.Text_IO, Net;
use Ada.Text_IO;
use type Net.Integer_32;

package body Debug is
   use System.Storage_Elements;

   function Dump (p : Net.Payload_Type) return Net.Payload_Type is
   begin
      Dump (p);
      return p;
   end Dump;
   
   procedure Dump (p : Net.Payload_Type) is
   begin
      Dump (p.data, p.length);
   end Dump;
   
   procedure Dump (pointer : in System.Address;
                   len     : in Net.Integer_32;
                   offset  : in System.Storage_Elements.Storage_Offset := 0) is
      p : System.Address := pointer;
      l : Net.Integer_32 := len;
   begin
      loop
         Put_Line (To_Hex (p, l));
         exit when l <= 16;
         l := l - 16;
         p := p + System.Storage_Elements.Storage_Offset (16);
      end loop;
      New_Line;
   end Dump;
   
   function To_Hex (pointer  : System.Address;
                    len      : Net.Integer_32;
                    fillchar : Character := ' ';
                    max      : Net.Integer_32 := 16)
     return String is
      function min (a, b : Net.Integer_32) return Net.Integer_32;
      function min (a, b : Net.Integer_32) return Net.Integer_32 is
      begin
         if a < b then
            return a;
         else
            return b;
         end if;
      end min;
      pragma Inline (min);
      
      width  : constant Net.Integer_32 := Storage_Element'Size / 4;
      ende   : constant Net.Integer_32 := min (max, len);
      
      function to_hex (i : in Storage_Element) return String;
      function to_hex (i : in Storage_Element) return String is
         type nybble is mod 2**4;
         hex : constant array (nybble) of Character := "0123456789abcdef";
      begin
         case width is
            when 2 => return hex (nybble (i / hex'Length)) &
                             hex (nybble (i mod hex'Length));
            when 4 => return hex (nybble (i / hex'Length**3)) &
                             hex (nybble (i / hex'Length**2 mod hex'Length)) &
                             hex (nybble (i / hex'Length    mod hex'Length)) &
                             hex (nybble (i mod hex'Length));
            when others => raise Constraint_Error;
         end case;
      end to_hex;
      pragma Inline (to_hex);
      
      area : Storage_Array (0 .. Storage_Offset (ende - 1));
      for area'Address use pointer;
      
      result : String (1 .. Natural ((width + 1)*ende));
   begin
      for i in area'Range loop
         declare
            j : Natural := Natural (width + 1) * Natural (i);
         begin
            result (j + 1 .. j + Natural (width)) := to_hex (area (i));
            if j + Natural (width) + 1 /= result'Last then
               result (j + Natural (width) + 1) := fillchar;
            end if;
         end;
      end loop;
      return result;
   end To_Hex;
   
   procedure Log (msg : String) is
   begin
      Put_Line (msg);
   end Log;
end Debug;