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

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

2014-07-18  Eric Botcazou  <ebotcazou@adacore.com>

	* opt.ads (Suppress_Back_Annotation): Remove as unused.
	* fe.h (Back_Annotate_Rep_Info): Likewise.
	(Global_Discard_Names): Likewise.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212799 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c02198c367e3fda79ae30492de59d139a28aa68b..05d2da05f7825a7f29c909b462f3864d30e8af3e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2014-07-18  Thomas Quinot  <quinot@adacore.com>
+
+       * g-memdum.adb, g-memdum.ads (Dump): New parameter Prefix, defaulted
+       to Absolute_Address.
+
+2014-07-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * opt.ads (Suppress_Back_Annotation): Remove as unused.
+       * fe.h (Back_Annotate_Rep_Info): Likewise.
+       (Global_Discard_Names): Likewise.
+
 2014-07-18  Robert Dewar  <dewar@adacore.com>
 
        * sem_ch13.adb (Is_Type_Ref): Check that type name is not

diff --git a/gcc/ada/g-memdum.adb b/gcc/ada/g-memdum.adb
index 616d601ff18975879751e519ef316ed76652e5b0..31564c5b9f2a998916704a45a593539f609f2270 100644 (file)
--- a/gcc/ada/g-memdum.adb
+++ b/gcc/ada/g-memdum.adb
@@ -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 @@ package body GNAT.Memory_Dump is
    -- 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 @@ package body GNAT.Memory_Dump is
       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 @@ package body GNAT.Memory_Dump is
       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;
+
+      declare
+         Line_Buf : String (1 .. Line_Len);
+      begin
+         while Ctr /= 0 loop
+
+            --  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;
 
-         --  Start of line processing
-
-         if N = 0 then
-            declare
-               S : constant String := Image (Adr);
-            begin
-               Line_Buf (1 .. AIL) := S (4 .. S'Length - 1) & ": ";
                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;

diff --git a/gcc/ada/g-memdum.ads b/gcc/ada/g-memdum.ads
index 2cfd1c3124b5b0bdfa5ea4c1cc4d399f1654707c..919663cf5e35941afa910f56425320837cdf5a89 100644 (file)
--- a/gcc/ada/g-memdum.ads
+++ b/gcc/ada/g-memdum.ads
@@ -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 @@ with System;
 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