Patchwork [Ada] Alternate output modes for GNAT.Memory_Dump

login
register
mail settings
Submitter Arnaud Charlet
Date July 18, 2014, 9:55 a.m.
Message ID <20140718095510.GA30964@adacore.com>
Download mbox | patch
Permalink /patch/371431/
State New
Headers show

Comments

Arnaud Charlet - July 18, 2014, 9:55 a.m.
Output lines from GNAT.Memory_Dump.Dump can now be prefixed with an offset
relative to the start of the dump, or have no prefix at all, instead of
showing an absolute address.

Test:
$ gnatmake -q dump_test
$ ./dump_test
00: 4C 6F 72 65 6D 20 69 70 73 75 6D 20 64 6F 6C 6F "Lorem ipsum dolo"
10: 72 20 73 69 74 20 61 6D 65 74 2C 20 63 6F 6E 73 "r sit amet, cons"
20: 65 63 74 65 74 75 65 72 20 61 64 69 70 69 73 63 "ectetuer adipisc"
30: 69 6E 67 20 73 65 64 20 64 69 61 6D 20 6E 6F 6E "ing sed diam non"
40: 75 6D                                           "um"

with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Memory_Dump; use GNAT.Memory_Dump;
procedure Dump_Test is
   S : constant String := "Lorem ipsum dolor sit amet, consectetuer adipiscing"
                          & " sed diam nonum";
begin
   Dump (S'Address, S'Length, Offset);
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-07-18  Thomas Quinot  <quinot@adacore.com>

	* g-memdum.adb, g-memdum.ads (Dump): New parameter Prefix, defaulted
	to Absolute_Address.

Patch

Index: g-memdum.adb
===================================================================
--- g-memdum.adb	(revision 212640)
+++ g-memdum.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2003-2010, AdaCore                     --
+--                     Copyright (C) 2003-2014, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -30,6 +30,7 @@ 
 ------------------------------------------------------------------------------
 
 with System;                  use System;
+with System.Img_BIU;          use System.Img_BIU;
 with System.Storage_Elements; use System.Storage_Elements;
 
 with GNAT.IO;              use GNAT.IO;
@@ -43,10 +44,18 @@ 
    -- Dump --
    ----------
 
-   procedure Dump (Addr : System.Address; Count : Natural) is
+   procedure Dump
+     (Addr   : Address;
+      Count  : Natural;
+      Prefix : Prefix_Type := Absolute_Address)
+   is
       Ctr : Natural := Count;
       --  Count of bytes left to output
 
+      Offset_Buf  : String (1 .. Standard'Address_Size / 4 + 4);
+      Offset_Last : Natural;
+      --  Buffer for prefix in Offset mode
+
       Adr : Address := Addr;
       --  Current address
 
@@ -56,14 +65,12 @@ 
       C : Character;
       --  Character at current storage address
 
-      AIL : constant := Address_Image_Length - 4 + 2;
-      --  Number of chars in initial address + colon + space
+      AIL : Natural;
+      --  Number of chars in prefix (including colon and space)
 
-      Line_Len : constant Natural := AIL + 3 * 16 + 2 + 16;
+      Line_Len : Natural;
       --  Line length for entire line
 
-      Line_Buf : String (1 .. Line_Len);
-
       Hex : constant array (0 .. 15) of Character := "0123456789ABCDEF";
 
       type Char_Ptr is access all Character;
@@ -71,53 +78,89 @@ 
       function To_Char_Ptr is new Ada.Unchecked_Conversion (Address, Char_Ptr);
 
    begin
-      while Ctr /= 0 loop
+      case Prefix is
+         when Absolute_Address =>
+            AIL := Address_Image_Length - 4 + 2;
+         when Offset =>
+            Offset_Last := Offset_Buf'First - 1;
+            Set_Image_Based_Integer (Ctr, 16, 0, Offset_Buf, Offset_Last);
+            AIL := Offset_Last - 4 + 2;
+         when None =>
+            AIL := 0;
+      end case;
+      Line_Len := AIL + 3 * 16 + 2 + 16;
 
-         --  Start of line processing
+      declare
+         Line_Buf : String (1 .. Line_Len);
+      begin
+         while Ctr /= 0 loop
 
-         if N = 0 then
-            declare
-               S : constant String := Image (Adr);
-            begin
-               Line_Buf (1 .. AIL) := S (4 .. S'Length - 1) & ": ";
+            --  Start of line processing
+
+            if N = 0 then
+               case Prefix is
+                  when Absolute_Address =>
+                     declare
+                        S : constant String := Image (Adr);
+                     begin
+                        Line_Buf (1 .. AIL) := S (4 .. S'Length - 1) & ": ";
+                     end;
+
+                  when Offset =>
+                     declare
+                        Last : Natural := 0;
+                        Len  : Natural;
+                     begin
+                        Set_Image_Based_Integer
+                          (Count - Ctr, 16, 0, Offset_Buf, Last);
+                        Len := Last - 4;
+
+                        Line_Buf (1 .. AIL - Len - 2) := (others => '0');
+                        Line_Buf (AIL - Len - 1 .. AIL - 2) :=
+                          Offset_Buf (4 .. Last - 1);
+                        Line_Buf (AIL - 1 .. AIL) := ": ";
+                     end;
+                  when None =>
+                     null;
+               end case;
+
                Line_Buf (AIL + 1 .. Line_Buf'Last) := (others => ' ');
                Line_Buf (AIL + 3 * 16 + 1) := '"';
-            end;
-         end if;
+            end if;
 
-         --  Add one character to current line
+            --  Add one character to current line
 
-         C := To_Char_Ptr (Adr).all;
-         Adr := Adr + 1;
-         Ctr := Ctr - 1;
+            C := To_Char_Ptr (Adr).all;
+            Adr := Adr + 1;
+            Ctr := Ctr - 1;
 
-         Line_Buf (AIL + 3 * N + 1) := Hex (Character'Pos (C) / 16);
-         Line_Buf (AIL + 3 * N + 2) := Hex (Character'Pos (C) mod 16);
+            Line_Buf (AIL + 3 * N + 1) := Hex (Character'Pos (C) / 16);
+            Line_Buf (AIL + 3 * N + 2) := Hex (Character'Pos (C) mod 16);
 
-         if C < ' ' or else C = Character'Val (16#7F#) then
-            C := '?';
-         end if;
+            if C < ' ' or else C = Character'Val (16#7F#) then
+               C := '?';
+            end if;
 
-         Line_Buf (AIL + 3 * 16 + 2 + N) := C;
-         N := N + 1;
+            Line_Buf (AIL + 3 * 16 + 2 + N) := C;
+            N := N + 1;
 
-         --  End of line processing
+            --  End of line processing
 
-         if N = 16 then
-            Line_Buf (Line_Buf'Last) := '"';
-            GNAT.IO.Put_Line (Line_Buf);
-            N := 0;
-         end if;
-      end loop;
+            if N = 16 then
+               Line_Buf (Line_Buf'Last) := '"';
+               GNAT.IO.Put_Line (Line_Buf);
+               N := 0;
+            end if;
+         end loop;
 
-      --  Deal with possible last partial line
+         --  Deal with possible last partial line
 
-      if N /= 0 then
-         Line_Buf (AIL + 3 * 16 + 2 + N) := '"';
-         GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N));
-      end if;
+         if N /= 0 then
+            Line_Buf (AIL + 3 * 16 + 2 + N) := '"';
+            GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N));
+         end if;
+      end;
 
-      return;
    end Dump;
 
 end GNAT.Memory_Dump;
Index: g-memdum.ads
===================================================================
--- g-memdum.ads	(revision 212640)
+++ g-memdum.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2003-2010, AdaCore                     --
+--                     Copyright (C) 2003-2014, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -38,7 +38,12 @@ 
 package GNAT.Memory_Dump is
    pragma Preelaborate;
 
-   procedure Dump (Addr : System.Address; Count : Natural);
+   type Prefix_Type is (Absolute_Address, Offset, None);
+
+   procedure Dump
+     (Addr   : System.Address;
+      Count  : Natural;
+      Prefix : Prefix_Type := Absolute_Address);
    --  Dumps indicated number (Count) of bytes, starting at the address given
    --  by Addr. The coding of this routine in its current form assumes the
    --  case of a byte addressable machine (and is therefore inapplicable to