1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- G N A T . M E M O R Y _ D U M P -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2003-2010, AdaCore -- 10-- -- 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. -- 17-- -- 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. -- 21-- -- 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/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with System; use System; 33with System.Storage_Elements; use System.Storage_Elements; 34 35with GNAT.IO; use GNAT.IO; 36with GNAT.Debug_Utilities; use GNAT.Debug_Utilities; 37 38with Ada.Unchecked_Conversion; 39 40package body GNAT.Memory_Dump is 41 42 ---------- 43 -- Dump -- 44 ---------- 45 46 procedure Dump (Addr : System.Address; Count : Natural) is 47 Ctr : Natural := Count; 48 -- Count of bytes left to output 49 50 Adr : Address := Addr; 51 -- Current address 52 53 N : Natural := 0; 54 -- Number of bytes output on current line 55 56 C : Character; 57 -- Character at current storage address 58 59 AIL : constant := Address_Image_Length - 4 + 2; 60 -- Number of chars in initial address + colon + space 61 62 Line_Len : constant Natural := AIL + 3 * 16 + 2 + 16; 63 -- Line length for entire line 64 65 Line_Buf : String (1 .. Line_Len); 66 67 Hex : constant array (0 .. 15) of Character := "0123456789ABCDEF"; 68 69 type Char_Ptr is access all Character; 70 71 function To_Char_Ptr is new Ada.Unchecked_Conversion (Address, Char_Ptr); 72 73 begin 74 while Ctr /= 0 loop 75 76 -- Start of line processing 77 78 if N = 0 then 79 declare 80 S : constant String := Image (Adr); 81 begin 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) := '"'; 85 end; 86 end if; 87 88 -- Add one character to current line 89 90 C := To_Char_Ptr (Adr).all; 91 Adr := Adr + 1; 92 Ctr := Ctr - 1; 93 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); 96 97 if C < ' ' or else C = Character'Val (16#7F#) then 98 C := '?'; 99 end if; 100 101 Line_Buf (AIL + 3 * 16 + 2 + N) := C; 102 N := N + 1; 103 104 -- End of line processing 105 106 if N = 16 then 107 Line_Buf (Line_Buf'Last) := '"'; 108 GNAT.IO.Put_Line (Line_Buf); 109 N := 0; 110 end if; 111 end loop; 112 113 -- Deal with possible last partial line 114 115 if N /= 0 then 116 Line_Buf (AIL + 3 * 16 + 2 + N) := '"'; 117 GNAT.IO.Put_Line (Line_Buf (1 .. AIL + 3 * 16 + 2 + N)); 118 end if; 119 120 return; 121 end Dump; 122 123end GNAT.Memory_Dump; 124