aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/ada/g-memdum.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/ada/g-memdum.adb')
-rw-r--r--gcc-4.9/gcc/ada/g-memdum.adb123
1 files changed, 123 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/g-memdum.adb b/gcc-4.9/gcc/ada/g-memdum.adb
new file mode 100644
index 000000000..616d601ff
--- /dev/null
+++ b/gcc-4.9/gcc/ada/g-memdum.adb
@@ -0,0 +1,123 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- G N A T . M E M O R Y _ D U M P --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2003-2010, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with System; use System;
+with System.Storage_Elements; use System.Storage_Elements;
+
+with GNAT.IO; use GNAT.IO;
+with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
+
+with Ada.Unchecked_Conversion;
+
+package body GNAT.Memory_Dump is
+
+ ----------
+ -- Dump --
+ ----------
+
+ procedure Dump (Addr : System.Address; Count : Natural) is
+ Ctr : Natural := Count;
+ -- Count of bytes left to output
+
+ Adr : Address := Addr;
+ -- Current address
+
+ N : Natural := 0;
+ -- Number of bytes output on current line
+
+ C : Character;
+ -- Character at current storage address
+
+ AIL : constant := Address_Image_Length - 4 + 2;
+ -- Number of chars in initial address + colon + space
+
+ Line_Len : constant Natural := AIL + 3 * 16 + 2 + 16;
+ -- 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;
+
+ function To_Char_Ptr is new Ada.Unchecked_Conversion (Address, Char_Ptr);
+
+ begin
+ while Ctr /= 0 loop
+
+ -- 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;
+
+ -- Add one character to current line
+
+ 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);
+
+ if C < ' ' or else C = Character'Val (16#7F#) then
+ C := '?';
+ end if;
+
+ Line_Buf (AIL + 3 * 16 + 2 + N) := C;
+ N := N + 1;
+
+ -- 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;
+
+ -- 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;
+
+ return;
+ end Dump;
+
+end GNAT.Memory_Dump;