1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- G N A T . D E B U G _ U T I L I T I E S --
9 -- Copyright (C) 1997-2004 Ada Core Technologies, Inc. --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with System
; use System
;
35 with System
.Storage_Elements
; use System
.Storage_Elements
;
37 package body GNAT
.Debug_Utilities
is
39 H
: constant array (0 .. 15) of Character := "0123456789ABCDEF";
40 -- Table of hex digits
48 function Image
(A
: Address
) return Image_String
is
50 P
: Natural := Address_Image_Length
- 1;
51 N
: Integer_Address
:= To_Integer
(A
);
67 S
(P
) := H
(Integer (N
mod 16));
82 function Image
(S
: String) return String is
83 W
: String (1 .. 2 * S
'Length + 2);
108 function Image_C
(A
: Address
) return Image_C_String
is
110 N
: Integer_Address
:= To_Integer
(A
);
113 for P
in reverse 3 .. S
'Last loop
114 S
(P
) := H
(Integer (N
mod 16));
126 function Value
(S
: String) return System
.Address
is
127 Base
: Integer_Address
:= 10;
128 Res
: Integer_Address
:= 0;
129 Last
: Natural := S
'Last;
134 -- Skip final Ada 95 base character
136 if S
(Last
) = '#' or else S
(Last
) = ':' then
140 -- Loop through characters
142 for J
in S
'First .. Last
loop
145 -- C format hex constant
149 raise Constraint_Error
;
154 -- Ada form based literal
156 elsif C
= '#' or else C
= ':' then
160 -- Ignore all underlines
165 -- Otherwise must have digit
168 if C
in '0' .. '9' then
169 N
:= Character'Pos (C
) - Character'Pos ('0');
170 elsif C
in 'A' .. 'F' then
171 N
:= Character'Pos (C
) - (Character'Pos ('A') - 10);
172 elsif C
in 'a' .. 'f' then
173 N
:= Character'Pos (C
) - (Character'Pos ('a') - 10);
175 raise Constraint_Error
;
179 raise Constraint_Error
;
181 Res
:= Res
* Base
+ N
;
186 return To_Address
(Res
);
189 end GNAT
.Debug_Utilities
;