URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-memdum.adb] - Rev 724
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- 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;
Go to most recent revision | Compare with Previous | Blame | View Log