1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . M E M O R Y _ D U M P --
9 -- Copyright (C) 2003-2010, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with System
; use System
;
33 with System
.Storage_Elements
; use System
.Storage_Elements
;
35 with GNAT
.IO
; use GNAT
.IO
;
36 with GNAT
.Debug_Utilities
; use GNAT
.Debug_Utilities
;
38 with Ada
.Unchecked_Conversion
;
40 package body GNAT
.Memory_Dump
is
46 procedure Dump
(Addr
: System
.Address
; Count
: Natural) is
47 Ctr
: Natural := Count
;
48 -- Count of bytes left to output
50 Adr
: Address
:= Addr
;
54 -- Number of bytes output on current line
57 -- Character at current storage address
59 AIL
: constant := Address_Image_Length
- 4 + 2;
60 -- Number of chars in initial address + colon + space
62 Line_Len
: constant Natural := AIL
+ 3 * 16 + 2 + 16;
63 -- Line length for entire line
65 Line_Buf
: String (1 .. Line_Len
);
67 Hex
: constant array (0 .. 15) of Character := "0123456789ABCDEF";
69 type Char_Ptr
is access all Character;
71 function To_Char_Ptr
is new Ada
.Unchecked_Conversion
(Address
, Char_Ptr
);
76 -- Start of line processing
80 S
: constant String := Image
(Adr
);
82 Line_Buf
(1 .. AIL
) := S
(4 .. S
'Length - 1) & ": ";
83 Line_Buf
(AIL
+ 1 .. Line_Buf
'Last) := (others => ' ');
84 Line_Buf
(AIL
+ 3 * 16 + 1) := '"';
88 -- Add one character to current line
90 C
:= To_Char_Ptr
(Adr
).all;
94 Line_Buf
(AIL
+ 3 * N
+ 1) := Hex
(Character'Pos (C
) / 16);
95 Line_Buf
(AIL
+ 3 * N
+ 2) := Hex
(Character'Pos (C
) mod 16);
97 if C
< ' ' or else C
= Character'Val (16#
7F#
) then
101 Line_Buf
(AIL
+ 3 * 16 + 2 + N
) := C
;
104 -- End of line processing
107 Line_Buf
(Line_Buf
'Last) := '"';
108 GNAT
.IO
.Put_Line
(Line_Buf
);
113 -- Deal with possible last partial line
116 Line_Buf
(AIL
+ 3 * 16 + 2 + N
) := '"';
117 GNAT
.IO
.Put_Line
(Line_Buf
(1 .. AIL
+ 3 * 16 + 2 + N
));
123 end GNAT
.Memory_Dump
;