mirror/binutils-gdb
2
0
Fork 0
mirror of https://sourceware.org/git/binutils-gdb.git synced 2025-03-01 13:26:47 +08:00
Code Issues Packages Projects Releases Wiki Activity

2006-05-13 Gaius Mulley <gaius@glam.ac.uk>

Browse Source 
* gdb/m2-lang.h: added function extern prototypes for m2_is_long_set
	and get_long_set_bounds.
	* gm2/m2-typeprint.c: This file has been completely
	replaced to reflect the Modula-2 syntax rather than call the
	c_print_type function.
	(m2_print_type): walk the Modula-2 type tree.
	(m2_type_name): added.
	(m2_range): added.
	(m2_typedef): added.
	(m2_array): added.
	(m2_pointer): added.
	(m2_ref): added.
	(m2_unknown): added.
	(m2_union): added.
	(m2_procedure): added.
	(m2_print_bounds): added.
	(m2_short_set): added.
	(m2_is_long_set): added.
	(m2_get_discrete_bounds): added.
	(m2_is_long_set_of_type): added.
	(m2_long_set): added.
	(m2_record_fields): added.
	(m2_enum): added.
	* gdb/dwarf2read.c: added ability to detect the language Modula-2
	and handle SET and CHAR types.
	(read_set_type): added.
	(process_die): call read_set_type.
	(read_base_type): modifed signed/unsigned char handling for Modula-2.
	(set_cu_language): added Modula-2 case clause.
	* gdb/m2-valprint.c: complete replacement so that Modula-2 values are
	printed rather than call the C language routines.
	(print_function_pointer_address): added.
	(get_long_set_bounds): added.
	(m2_print_long_set): added.
	(print_unpacked_pointer): added.
	(print_variable_at_address): added.
	(m2_val_print): replaced.
This commit is contained in:
Gaius Mulley 2006-05-13 15:46:38 +00:00
parent 34addd0f72
commit 72019c9cbc
8 changed files with 1341 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
gdb/ChangeLog
View File

@ -1,3 +1,43 @@
2006-05-13 Gaius Mulley <gaius@glam.ac.uk>
* gdb/m2-lang.h: added function extern prototypes for m2_is_long_set and
get_long_set_bounds.
* gm2/m2-typeprint.c: This file has been completely
replaced to reflect the Modula-2 syntax rather than call the
c_print_type function.
(m2_print_type): walk the Modula-2 type tree.
(m2_type_name): added.
(m2_range): added.
(m2_typedef): added.
(m2_array): added.
(m2_pointer): added.
(m2_ref): added.
(m2_unknown): added.
(m2_union): added.
(m2_procedure): added.
(m2_print_bounds): added.
(m2_short_set): added.
(m2_is_long_set): added.
(m2_get_discrete_bounds): added.
(m2_is_long_set_of_type): added.
(m2_long_set): added.
(m2_record_fields): added.
(m2_enum): added.
* gdb/dwarf2read.c: added ability to detect the language Modula-2
and handle SET and CHAR types.
(read_set_type): added.
(process_die): call read_set_type.
(read_base_type): modifed signed/unsigned char handling for Modula-2.
(set_cu_language): added Modula-2 case clause.
* gdb/m2-valprint.c: complete replacement so that Modula-2 values are
printed rather than call the C language routines.
(print_function_pointer_address): added.
(get_long_set_bounds): added.
(m2_print_long_set): added.
(print_unpacked_pointer): added.
(print_variable_at_address): added.
(m2_val_print): replaced.
2006-05-12 Mark Kettenis <kettenis@gnu.org>
* ppcnbsd-tdep.h: Update copyright year. Include <stddef.h>

1
gdb/MAINTAINERS
View File

@ -503,6 +503,7 @@ Marko Mlinar markom@opencores.org
Alan Modra amodra@bigpond.net.au
Jason Molenda jmolenda@apple.com
Pierre Muller muller@sources.redhat.com
Gaius Mulley gaius@glam.ac.uk
Joseph Myers joseph@codesourcery.com
Fernando Nasser fnasser@redhat.com
Nathanael Nerode neroden@gcc.gnu.org

4
gdb/doc/ChangeLog
View File

@ -1,3 +1,7 @@
2006-05-13 Gaius Mulley <gaius@glam.ac.uk>
* gdb/doc/gdb.texinfo: added a section on Modula-2 Types.
2006-05-10 Daniel Jacobowitz <dan@codesourcery.com>
* agentexpr.texi: Add a copyright and license notice.

167
gdb/doc/gdb.texinfo
View File

@ -9471,6 +9471,7 @@ table.
* M2 Operators:: Built-in operators
* Built-In Func/Proc:: Built-in functions and procedures
* M2 Constants:: Modula-2 constants
* M2 Types:: Modula-2 types
* M2 Defaults:: Default settings for Modula-2
* Deviations:: Deviations from standard Modula-2
* M2 Checks:: Modula-2 type and range checks
@ -9595,7 +9596,7 @@ as @code{^}.
@end table
@quotation
@emph{Warning:} Sets and their operations are not yet supported, so @value{GDBN}
@emph{Warning:} Set expressions and their operations are not yet supported, so @value{GDBN}
treats the use of the operator @code{IN}, or the use of operators
@code{+}, @code{-}, @code{*}, @code{/}, @code{=}, , @code{<>}, @code{#},
@code{<=}, and @code{>=} on sets as an error.
@ -9764,6 +9765,170 @@ Pointer constants consist of integral values only.
Set constants are not yet supported.
@end itemize
@node M2 Types
@subsubsection Modula-2 Types
@cindex Modula-2 types
Currently @value{GDBN} can print the following data types in Modula-2
syntax: array types, record types, set types, pointer types, procedure
types, enumerated types, subrange types and base types. You can also
print the contents of variables declared using these type.
This section gives a number of simple source code examples together with
sample @value{GDBN} sessions.
The first example contains the following section of code:
@smallexample
VAR
s: SET OF CHAR ;
r: [20..40] ;
@end smallexample
@noindent
and you can request @value{GDBN} to interrogate the type and value of
@code{r} and @code{s}.
@smallexample
(@value{GDBP}) print s
@{'A'..'C', 'Z'@}
(@value{GDBP}) ptype s
SET OF CHAR
(@value{GDBP}) print r
21
(@value{GDBP}) ptype r
[20..40]
@end smallexample
@noindent
Likewise if your source code declares @code{s} as:
@smallexample
VAR
s: SET ['A'..'Z'] ;
@end smallexample
@noindent
then you may query the type of @code{s} by:
@smallexample
(@value{GDBP}) ptype s
type = SET ['A'..'Z']
@end smallexample
@noindent
Note that at present you cannot interactively manipulate set
expressions using the debugger.
The following example shows how you might declare an array in Modula-2
and how you can interact with @value{GDBN} to print its type and contents:
@smallexample
VAR
s: ARRAY [-10..10] OF CHAR ;
@end smallexample
@smallexample
(@value{GDBP}) ptype s
ARRAY [-10..10] OF CHAR
@end smallexample
Note that the array handling is not yet complete and although the type
is printed correctly, expression handling still assumes that all
arrays have a lower bound of zero and not @code{-10} as in the example
above. Unbounded arrays are also not yet recognized in @value{GDBN}.
Here are some more type related Modula-2 examples:
@smallexample
TYPE
colour = (blue, red, yellow, green) ;
t = [blue..yellow] ;
VAR
s: t ;
BEGIN
s := blue ;
@end smallexample
@noindent
The @value{GDBN} interaction shows how you can query the data type
and value of a variable.
@smallexample
(@value{GDBP}) print s
$1 = blue
(@value{GDBP}) ptype t
type = [blue..yellow]
@end smallexample
@noindent
In this example a Modula-2 array is declared and its contents
displayed. Observe that the contents are written in the same way as
their @code{C} counterparts.
@smallexample
VAR
s: ARRAY [1..5] OF CARDINAL ;
BEGIN
s[1] := 1 ;
@end smallexample
@smallexample
(@value{GDBP}) print s
$1 = @{1, 0, 0, 0, 0@}
(@value{GDBP}) ptype s
type = ARRAY [1..5] OF CARDINAL
@end smallexample
The Modula-2 language interface to @value{GDBN} also understands
pointer types as shown in this example:
@smallexample
VAR
s: POINTER TO ARRAY [1..5] OF CARDINAL ;
BEGIN
NEW(s) ;
s^[1] := 1 ;
@end smallexample
@noindent
and you can request that @value{GDBN} describes the type of @code{s}.
@smallexample
(@value{GDBP}) ptype s
type = POINTER TO ARRAY [1..5] OF CARDINAL
@end smallexample
@value{GDBN} handles compound types as we can see in this example.
Here we combine array types, record types, pointer types and subrange
types:
@smallexample
TYPE
foo = RECORD
f1: CARDINAL ;
f2: CHAR ;
f3: myarray ;
END ;
myarray = ARRAY myrange OF CARDINAL ;
myrange = [-2..2] ;
VAR
s: POINTER TO ARRAY myrange OF foo ;
@end smallexample
@noindent
and you can ask @value{GDBN} to describe the type of @code{s} as shown
below.
@smallexample
(@value{GDBP}) ptype s
type = POINTER TO ARRAY [-2..2] OF foo = RECORD
f1 : CARDINAL;
f2 : CHAR;
f3 : ARRAY [-2..2] OF CARDINAL;
END
@end smallexample
@node M2 Defaults
@subsubsection Modula-2 defaults
@cindex Modula-2 defaults

38
gdb/dwarf2read.c
View File

@ -1,7 +1,7 @@
/* DWARF 2 debugging format support for GDB.
Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
2004, 2005, 2006
Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006
Free Software Foundation, Inc.
Adapted by Gary Funck (gary@intrepid.com), Intrepid Technology,
@ -1073,6 +1073,9 @@ static void dwarf2_mark (struct dwarf2_cu *);
static void dwarf2_clear_marks (struct dwarf2_per_cu_data *);
static void read_set_type (struct die_info *, struct dwarf2_cu *);
/* Try to locate the sections we need for DWARF 2 debugging
information and return true if we have enough to do something. */
@ -2662,6 +2665,9 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
case DW_TAG_subroutine_type:
read_subroutine_type (die, cu);
break;
case DW_TAG_set_type:
read_set_type (die, cu);
break;
case DW_TAG_array_type:
read_array_type (die, cu);
break;
@ -4240,6 +4246,15 @@ read_array_order (struct die_info *die, struct dwarf2_cu *cu)
};
}
/* Extract all information from a DW_TAG_set_type DIE and put it in
the DIE's type field. */
static void
read_set_type (struct die_info *die, struct dwarf2_cu *cu)
{
if (die->type == NULL)
die->type = create_set_type ((struct type *) NULL, die_type (die, cu));
}
/* First cut: install each common block member as a global variable. */
@ -4728,10 +4743,17 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
code = TYPE_CODE_FLT;
break;
case DW_ATE_signed:
case DW_ATE_signed_char:
break;
case DW_ATE_unsigned:
case DW_ATE_unsigned_char:
type_flags |= TYPE_FLAG_UNSIGNED;
break;
case DW_ATE_signed_char:
if (cu->language == language_m2)
code = TYPE_CODE_CHAR;
break;
case DW_ATE_unsigned_char:
if (cu->language == language_m2)
code = TYPE_CODE_CHAR;
type_flags |= TYPE_FLAG_UNSIGNED;
break;
default:
@ -6168,10 +6190,12 @@ set_cu_language (unsigned int lang, struct dwarf2_cu *cu)
case DW_LANG_Ada95:
cu->language = language_ada;
break;
case DW_LANG_Modula2:
cu->language = language_m2;
break;
case DW_LANG_Cobol74:
case DW_LANG_Cobol85:
case DW_LANG_Pascal83:
case DW_LANG_Modula2:
default:
cu->language = language_minimal;
break;
@ -6961,6 +6985,7 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
case DW_TAG_class_type:
case DW_TAG_structure_type:
case DW_TAG_union_type:
case DW_TAG_set_type:
case DW_TAG_enumeration_type:
SYMBOL_CLASS (sym) = LOC_TYPEDEF;
SYMBOL_DOMAIN (sym) = STRUCT_DOMAIN;
@ -7290,6 +7315,9 @@ read_type_die (struct die_info *die, struct dwarf2_cu *cu)
case DW_TAG_array_type:
read_array_type (die, cu);
break;
case DW_TAG_set_type:
read_set_type (die, cu);
break;
case DW_TAG_pointer_type:
read_tag_pointer_type (die, cu);
break;

5
gdb/m2-lang.h
View File

@ -27,6 +27,11 @@ extern void m2_error (char *); /* Defined in m2-exp.y */
extern void m2_print_type (struct type *, char *, struct ui_file *, int,
int);
extern int m2_is_long_set (struct type *type);
extern int m2_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
struct ui_file *, int, int, int,
enum val_prettyprint);
extern int get_long_set_bounds (struct type *type, LONGEST *low,
LONGEST *high);

543
gdb/m2-typeprint.c
View File

@ -1,5 +1,6 @@
/* Support for printing Modula 2 types for GDB, the GNU debugger.
Copyright (C) 1986, 1988, 1989, 1991, 1992, 1995, 2000
Copyright (C) 1986, 1988, 1989, 1991, 1992, 1995, 2000, 2001,
2002, 2003, 2004, 2005, 2006
Free Software Foundation, Inc.
This file is part of GDB.
@ -20,22 +21,554 @@
Boston, MA 02110-1301, USA. */
#include "defs.h"
#include "gdb_obstack.h"
#include "bfd.h" /* Binary File Description */
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "target.h"
#include "m2-lang.h"
#include "target.h"
#include "language.h"
#include "demangle.h"
#include "c-lang.h"
#include "typeprint.h"
#include "cp-abi.h"
#include "gdb_string.h"
#include <errno.h>
static void m2_print_bounds (struct type *type,
struct ui_file *stream, int show, int level,
int print_high);
static void m2_typedef (struct type *, struct ui_file *, int, int);
static void m2_array (struct type *, struct ui_file *, int, int);
static void m2_pointer (struct type *, struct ui_file *, int, int);
static void m2_ref (struct type *, struct ui_file *, int, int);
static void m2_procedure (struct type *, struct ui_file *, int, int);
static void m2_union (struct type *, struct ui_file *);
static void m2_enum (struct type *, struct ui_file *, int, int);
static void m2_range (struct type *, struct ui_file *, int, int);
static void m2_type_name (struct type *type, struct ui_file *stream);
static void m2_short_set (struct type *type, struct ui_file *stream,
int show, int level);
static int m2_long_set (struct type *type, struct ui_file *stream,
int show, int level);
static void m2_record_fields (struct type *type, struct ui_file *stream,
int show, int level);
static void m2_unknown (const char *s, struct type *type,
struct ui_file *stream, int show, int level);
int m2_is_long_set (struct type *type);
int m2_is_long_set_of_type (struct type *type, struct type **of_type);
void
m2_print_type (struct type *type, char *varstring, struct ui_file *stream,
int show, int level)
{
extern void c_print_type (struct type *, char *, struct ui_file *, int,
int);
enum type_code code;
int demangled_args;
c_print_type (type, varstring, stream, show, level); /* FIXME */
CHECK_TYPEDEF (type);
code = TYPE_CODE (type);
QUIT;
wrap_here (" ");
if (type == NULL)
{
fputs_filtered (_("<type unknown>"), stream);
return;
}
switch (TYPE_CODE (type))
{
case TYPE_CODE_SET:
m2_short_set(type, stream, show, level);
break;
case TYPE_CODE_STRUCT:
if (m2_long_set (type, stream, show, level))
break;
m2_record_fields (type, stream, show, level);
break;
case TYPE_CODE_TYPEDEF:
m2_typedef (type, stream, show, level);
break;
case TYPE_CODE_ARRAY:
m2_array (type, stream, show, level);
break;
case TYPE_CODE_PTR:
m2_pointer (type, stream, show, level);
break;
case TYPE_CODE_REF:
m2_ref (type, stream, show, level);
break;
case TYPE_CODE_MEMBER:
m2_unknown (_("member"), type, stream, show, level);
break;
case TYPE_CODE_METHOD:
m2_unknown (_("method"), type, stream, show, level);
break;
case TYPE_CODE_FUNC:
m2_procedure (type, stream, show, level);
break;
case TYPE_CODE_UNION:
m2_union (type, stream);
break;
case TYPE_CODE_ENUM:
m2_enum (type, stream, show, level);
break;
case TYPE_CODE_VOID:
break;
case TYPE_CODE_UNDEF:
/* i18n: Do not translate the "struct" part! */
m2_unknown (_("undef"), type, stream, show, level);
break;
case TYPE_CODE_ERROR:
m2_unknown (_("error"), type, stream, show, level);
break;
case TYPE_CODE_RANGE:
m2_range (type, stream, show, level);
break;
case TYPE_CODE_TEMPLATE:
break;
default:
m2_type_name (type, stream);
break;
}
}
/*
* m2_type_name - if a, type, has a name then print it.
*/
void
m2_type_name (struct type *type, struct ui_file *stream)
{
if (TYPE_NAME (type) != NULL)
fputs_filtered (TYPE_NAME (type), stream);
}
/*
* m2_range - displays a Modula-2 subrange type.
*/
void
m2_range (struct type *type, struct ui_file *stream, int show,
int level)
{
if (TYPE_HIGH_BOUND (type) == TYPE_LOW_BOUND (type))
m2_print_type (TYPE_DOMAIN_TYPE (type), "", stream, show, level);
else
{
struct type *target = TYPE_TARGET_TYPE (type);
fprintf_filtered (stream, "[");
print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
fprintf_filtered (stream, "..");
print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
fprintf_filtered (stream, "]");
}
}
static void
m2_typedef (struct type *type, struct ui_file *stream, int show,
int level)
{
if (TYPE_NAME (type) != NULL)
{
fputs_filtered (TYPE_NAME (type), stream);
fputs_filtered (" = ", stream);
}
m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
}
/*
* m2_array - prints out a Modula-2 ARRAY ... OF type
*/
static void m2_array (struct type *type, struct ui_file *stream,
int show, int level)
{
fprintf_filtered (stream, "ARRAY [");
if (TYPE_LENGTH (type) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
&& TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED)
{
if (TYPE_INDEX_TYPE (type) != 0)
{
m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 0);
fprintf_filtered (stream, "..");
m2_print_bounds (TYPE_INDEX_TYPE (type), stream, show, -1, 1);
}
else
fprintf_filtered (stream, "%d",
(TYPE_LENGTH (type)
/ TYPE_LENGTH (TYPE_TARGET_TYPE (type))));
}
fprintf_filtered (stream, "] OF ");
m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
}
static void
m2_pointer (struct type *type, struct ui_file *stream, int show,
int level)
{
if (TYPE_CONST (type))
fprintf_filtered (stream, "[...] : ");
else
fprintf_filtered (stream, "POINTER TO ");
m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
}
static void
m2_ref (struct type *type, struct ui_file *stream, int show,
int level)
{
fprintf_filtered (stream, "VAR");
m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
}
static void
m2_unknown (const char *s, struct type *type, struct ui_file *stream,
int show, int level)
{
fprintf_filtered (stream, "%s %s", s, _("is unknown"));
}
static void m2_union (struct type *type, struct ui_file *stream)
{
fprintf_filtered (stream, "union");
}
static void
m2_procedure (struct type *type, struct ui_file *stream,
int show, int level)
{
fprintf_filtered (stream, "PROCEDURE ");
m2_type_name (type, stream);
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
{
int i, len = TYPE_NFIELDS (type);
fprintf_filtered (stream, " (");
for (i = 0; i < len; i++)
{
if (i > 0)
{
fputs_filtered (", ", stream);
wrap_here (" ");
}
m2_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
}
if (TYPE_TARGET_TYPE (type) != NULL)
{
fprintf_filtered (stream, " : ");
m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
}
}
}
static void
m2_print_bounds (struct type *type,
struct ui_file *stream, int show, int level,
int print_high)
{
struct type *target = TYPE_TARGET_TYPE (type);
if (target == NULL)
target = builtin_type_int;
if (TYPE_NFIELDS(type) == 0)
return;
if (print_high)
print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
else
print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
}
static void
m2_short_set (struct type *type, struct ui_file *stream, int show, int level)
{
fprintf_filtered(stream, "SET [");
m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
show - 1, level, 0);
fprintf_filtered(stream, "..");
m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
show - 1, level, 1);
fprintf_filtered(stream, "]");
}
int
m2_is_long_set (struct type *type)
{
LONGEST previous_high = 0; /* unnecessary initialization
keeps gcc -Wall happy */
int len, i;
struct type *range;
if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
/*
* check if all fields of the RECORD are consecutive sets
*/
len = TYPE_NFIELDS (type);
for (i = TYPE_N_BASECLASSES (type); i < len; i++)
{
if (TYPE_FIELD_TYPE (type, i) == NULL)
return 0;
if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) != TYPE_CODE_SET)
return 0;
if (TYPE_FIELD_NAME (type, i) != NULL
&& (strcmp (TYPE_FIELD_NAME (type, i), "") != 0))
return 0;
range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
if ((i > TYPE_N_BASECLASSES (type))
&& previous_high + 1 != TYPE_LOW_BOUND (range))
return 0;
previous_high = TYPE_HIGH_BOUND (range);
}
return len>0;
}
return 0;
}
/*
* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
* understands that CHARs might be signed.
* This should be integrated into gdbtypes.c
* inside get_discrete_bounds.
*/
int
m2_get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)
{
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
case TYPE_CODE_CHAR:
if (TYPE_LENGTH (type) < sizeof (LONGEST))
{
if (!TYPE_UNSIGNED (type))
{
*lowp = -(1 << (TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1));
*highp = -*lowp - 1;
return 0;
}
}
/* fall through */
default:
return get_discrete_bounds (type, lowp, highp);
}
}
/*
* m2_is_long_set_of_type - returns TRUE if the long set was declared as
* SET OF <oftype> of_type is assigned to the
* subtype.
*/
int
m2_is_long_set_of_type (struct type *type, struct type **of_type)
{
int len, i;
struct type *range;
struct type *target;
LONGEST l1, l2;
LONGEST h1, h2;
if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
len = TYPE_NFIELDS (type);
i = TYPE_N_BASECLASSES (type);
if (len == 0)
return 0;
range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
target = TYPE_TARGET_TYPE (range);
if (target == NULL)
target = builtin_type_int;
l1 = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
h1 = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)));
*of_type = target;
if (m2_get_discrete_bounds (target, &l2, &h2) >= 0)
return (l1 == l2 && h1 == h2);
error (_("long_set failed to find discrete bounds for its subtype"));
return 0;
}
error (_("expecting long_set"));
return 0;
}
static int
m2_long_set (struct type *type, struct ui_file *stream, int show, int level)
{
struct type *index_type;
struct type *range_type;
struct type *of_type;
int i;
int len = TYPE_NFIELDS (type);
LONGEST low;
LONGEST high;
if (m2_is_long_set (type))
{
if (TYPE_TAG_NAME (type) != NULL)
{
fputs_filtered (TYPE_TAG_NAME (type), stream);
if (show == 0)
return 1;
}
else if (TYPE_NAME (type) != NULL)
{
fputs_filtered (TYPE_NAME (type), stream);
if (show == 0)
return 1;
}
if (TYPE_TAG_NAME (type) != NULL || TYPE_NAME (type) != NULL)
fputs_filtered (" = ", stream);
if (get_long_set_bounds (type, &low, &high))
{
fprintf_filtered(stream, "SET OF ");
i = TYPE_N_BASECLASSES (type);
if (m2_is_long_set_of_type (type, &of_type))
m2_print_type (of_type, "", stream, show - 1, level);
else
{
fprintf_filtered(stream, "[");
m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)),
stream, show - 1, level, 0);
fprintf_filtered(stream, "..");
m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)),
stream, show - 1, level, 1);
fprintf_filtered(stream, "]");
}
}
else
/* i18n: Do not translate the "SET OF" part! */
fprintf_filtered(stream, _("SET OF <unknown>"));
return 1;
}
return 0;
}
void
m2_record_fields (struct type *type, struct ui_file *stream, int show,
int level)
{
/* Print the tag if it exists.
*/
if (TYPE_TAG_NAME (type) != NULL)
{
if (strncmp (TYPE_TAG_NAME (type), "$$", 2) != 0)
{
fputs_filtered (TYPE_TAG_NAME (type), stream);
if (show > 0)
fprintf_filtered (stream, " = ");
}
}
wrap_here (" ");
if (show < 0)
{
if (TYPE_CODE (type) == DECLARED_TYPE_STRUCT)
fprintf_filtered (stream, "RECORD ... END ");
else if (TYPE_DECLARED_TYPE (type) == DECLARED_TYPE_UNION)
fprintf_filtered (stream, "CASE ... END ");
}
else if (show > 0)
{
if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
fprintf_filtered (stream, "RECORD\n");
else if (TYPE_CODE (type) == TYPE_CODE_UNION)
/* i18n: Do not translate "CASE" and "OF" */
fprintf_filtered (stream, _("CASE <variant> OF\n"));
int i;
int len = TYPE_NFIELDS (type);
for (i = TYPE_N_BASECLASSES (type); i < len; i++)
{
QUIT;
print_spaces_filtered (level + 4, stream);
fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
fputs_filtered (" : ", stream);
m2_print_type (TYPE_FIELD_TYPE (type, i),
"",
stream, 0, level + 4);
if (TYPE_FIELD_PACKED (type, i))
{
/* It is a bitfield. This code does not attempt
to look at the bitpos and reconstruct filler,
unnamed fields. This would lead to misleading
results if the compiler does not put out fields
for such things (I don't know what it does). */
fprintf_filtered (stream, " : %d",
TYPE_FIELD_BITSIZE (type, i));
}
fprintf_filtered (stream, ";\n");
}
fprintfi_filtered (level, stream, "END ");
}
}
void
m2_enum (struct type *type, struct ui_file *stream, int show, int level)
{
int lastval, i, len;
if (show < 0)
{
/* If we just printed a tag name, no need to print anything else. */
if (TYPE_TAG_NAME (type) == NULL)
fprintf_filtered (stream, "(...)");
}
else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
{
fprintf_filtered (stream, "(");
len = TYPE_NFIELDS (type);
lastval = 0;
for (i = 0; i < len; i++)
{
QUIT;
if (i > 0)
fprintf_filtered (stream, ", ");
wrap_here (" ");
fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
if (lastval != TYPE_FIELD_BITPOS (type, i))
{
fprintf_filtered (stream, " = %d", TYPE_FIELD_BITPOS (type, i));
lastval = TYPE_FIELD_BITPOS (type, i);
}
lastval++;
}
fprintf_filtered (stream, ")");
}
}

559
gdb/m2-valprint.c
View File

@ -1,7 +1,8 @@
/* Support for printing Modula 2 values for GDB, the GNU debugger.
Copyright (C) 1986, 1988, 1989, 1991, 1992, 1996, 1998, 2000, 2005 Free
Software Foundation, Inc.
Copyright (C) 1986, 1988, 1989, 1991, 1992, 1996, 1998,
2000, 2005, 2006
Free Software Foundation, Inc.
This file is part of GDB.
@ -23,14 +24,562 @@
#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "m2-lang.h"
#include "expression.h"
#include "value.h"
#include "valprint.h"
#include "language.h"
#include "typeprint.h"
#include "c-lang.h"
#include "m2-lang.h"
#include "target.h"
int print_unpacked_pointer (struct type *type,
CORE_ADDR address, CORE_ADDR addr,
int format, struct ui_file *stream);
/* Print function pointer with inferior address ADDRESS onto stdio
stream STREAM. */
static void
print_function_pointer_address (CORE_ADDR address, struct ui_file *stream)
{
CORE_ADDR func_addr = gdbarch_convert_from_func_ptr_addr (current_gdbarch,
address,
&current_target);
/* If the function pointer is represented by a description, print the
address of the description. */
if (addressprint && func_addr != address)
{
fputs_filtered ("@", stream);
fputs_filtered (paddress (address), stream);
fputs_filtered (": ", stream);
}
print_address_demangle (func_addr, stream, demangle);
}
/*
* get_long_set_bounds - assigns the bounds of the long set to low and high.
*/
int
get_long_set_bounds (struct type *type, LONGEST *low, LONGEST *high)
{
int len, i;
if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
len = TYPE_NFIELDS (type);
i = TYPE_N_BASECLASSES (type);
if (len == 0)
return 0;
*low = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
*high = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type,
len-1)));
return 1;
}
error (_("expecting long_set"));
return 0;
}
static void
m2_print_long_set (struct type *type, const gdb_byte *valaddr,
int embedded_offset, CORE_ADDR address,
struct ui_file *stream, int format,
enum val_prettyprint pretty)
{
int empty_set = 1;
int element_seen = 0;
LONGEST previous_low = 0;
LONGEST previous_high= 0;
LONGEST i, low_bound, high_bound;
LONGEST field_low, field_high;
struct type *range;
int len, field;
struct type *target;
int bitval;
CHECK_TYPEDEF (type);
fprintf_filtered (stream, "{");
len = TYPE_NFIELDS (type);
if (get_long_set_bounds (type, &low_bound, &high_bound))
{
field = TYPE_N_BASECLASSES (type);
range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
}
else
{
fprintf_filtered (stream, " %s }", _("<unknown bounds of set>"));
return;
}
target = TYPE_TARGET_TYPE (range);
if (target == NULL)
target = builtin_type_int;
if (get_discrete_bounds (range, &field_low, &field_high) >= 0)
{
for (i = low_bound; i <= high_bound; i++)
{
bitval = value_bit_index (TYPE_FIELD_TYPE (type, field),
(TYPE_FIELD_BITPOS (type, field) / 8) +
valaddr + embedded_offset, i);
if (bitval < 0)
error (_("bit test is out of range"));
else if (bitval > 0)
{
previous_high = i;
if (! element_seen)
{
if (! empty_set)
fprintf_filtered (stream, ", ");
print_type_scalar (target, i, stream);
empty_set = 0;
element_seen = 1;
previous_low = i;
}
}
else
{
/* bit is not set */
if (element_seen)
{
if (previous_low+1 < previous_high)
fprintf_filtered (stream, "..");
if (previous_low+1 < previous_high)
print_type_scalar (target, previous_high, stream);
element_seen = 0;
}
}
if (i == field_high)
{
field++;
if (field == len)
break;
range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, field));
if (get_discrete_bounds (range, &field_low, &field_high) < 0)
break;
target = TYPE_TARGET_TYPE (range);
if (target == NULL)
target = builtin_type_int;
}
}
if (element_seen)
{
if (previous_low+1 < previous_high)
{
fprintf_filtered (stream, "..");
print_type_scalar (target, previous_high, stream);
}
element_seen = 0;
}
fprintf_filtered (stream, "}");
}
}
int
print_unpacked_pointer (struct type *type,
CORE_ADDR address, CORE_ADDR addr,
int format, struct ui_file *stream)
{
struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
{
/* Try to print what function it points to. */
print_function_pointer_address (addr, stream);
/* Return value is irrelevant except for string pointers. */
return 0;
}
if (addressprint && format != 's')
fputs_filtered (paddress (address), stream);
/* For a pointer to char or unsigned char, also print the string
pointed to, unless pointer is null. */
if (TYPE_LENGTH (elttype) == 1
&& TYPE_CODE (elttype) == TYPE_CODE_INT
&& (format == 0 || format == 's')
&& addr != 0)
return val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
return 0;
}
static void
print_variable_at_address (struct type *type, const gdb_byte *valaddr,
struct ui_file *stream, int format,
int deref_ref, int recurse,
enum val_prettyprint pretty)
{
CORE_ADDR addr = unpack_pointer (type, valaddr);
struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
fprintf_filtered (stream, "[");
fputs_filtered (paddress (addr), stream);
fprintf_filtered (stream, "] : ");
if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
{
struct value *deref_val =
value_at
(TYPE_TARGET_TYPE (type),
unpack_pointer (lookup_pointer_type (builtin_type_void),
valaddr));
common_val_print (deref_val, stream, format, deref_ref,
recurse, pretty);
}
else
fputs_filtered ("???", stream);
}
/* Print data of type TYPE located at VALADDR (within GDB), which came from
the inferior at address ADDRESS, onto stdio stream STREAM according to
FORMAT (a letter or 0 for natural format). The data at VALADDR is in
target byte order.
If the data are a string pointer, returns the number of string characters
printed.
If DEREF_REF is nonzero, then dereference references, otherwise just print
them like pointers.
The PRETTY parameter controls prettyprinting. */
int
m2_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
CORE_ADDR address, struct ui_file *stream, int format,
int deref_ref, int recurse, enum val_prettyprint pretty)
{
return (c_val_print (type, valaddr, 0, address, stream, format, deref_ref,
recurse, pretty));
unsigned int i = 0; /* Number of characters printed */
unsigned len;
struct type *elttype;
unsigned eltlen;
int length_pos, length_size, string_pos;
int char_size;
LONGEST val;
CORE_ADDR addr;
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
case TYPE_CODE_ARRAY:
if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
{
elttype = check_typedef (TYPE_TARGET_TYPE (type));
eltlen = TYPE_LENGTH (elttype);
len = TYPE_LENGTH (type) / eltlen;
if (prettyprint_arrays)
print_spaces_filtered (2 + 2 * recurse, stream);
/* For an array of chars, print with string syntax. */
if (eltlen == 1 &&
((TYPE_CODE (elttype) == TYPE_CODE_INT)
|| ((current_language->la_language == language_m2)
&& (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
&& (format == 0 || format == 's'))
{
/* If requested, look for the first null char and only print
elements up to it. */
if (stop_print_at_null)
{
unsigned int temp_len;
/* Look for a NULL char. */
for (temp_len = 0;
(valaddr + embedded_offset)[temp_len]
&& temp_len < len && temp_len < print_max;
temp_len++);
len = temp_len;
}
LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0);
i = len;
}
else
{
fprintf_filtered (stream, "{");
val_print_array_elements (type, valaddr + embedded_offset,
address, stream, format, deref_ref,
recurse, pretty, 0);
fprintf_filtered (stream, "}");
}
break;
}
/* Array of unspecified length: treat like pointer to first elt. */
print_unpacked_pointer (type, address, address, format, stream);
break;
case TYPE_CODE_PTR:
if (TYPE_CONST (type))
print_variable_at_address (type, valaddr + embedded_offset,
stream, format, deref_ref, recurse,
pretty);
else if (format && format != 's')
print_scalar_formatted (valaddr + embedded_offset, type, format,
0, stream);
else
{
addr = unpack_pointer (type, valaddr + embedded_offset);
print_unpacked_pointer (type, addr, address, format, stream);
}
break;
case TYPE_CODE_MEMBER:
error (_("not implemented: member type in m2_val_print"));
break;
case TYPE_CODE_REF:
elttype = check_typedef (TYPE_TARGET_TYPE (type));
if (addressprint)
{
CORE_ADDR addr
= extract_typed_address (valaddr + embedded_offset, type);
fprintf_filtered (stream, "@");
fputs_filtered (paddress (addr), stream);
if (deref_ref)
fputs_filtered (": ", stream);
}
/* De-reference the reference. */
if (deref_ref)
{
if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
{
struct value *deref_val =
value_at
(TYPE_TARGET_TYPE (type),
unpack_pointer (lookup_pointer_type (builtin_type_void),
valaddr + embedded_offset));
common_val_print (deref_val, stream, format, deref_ref,
recurse, pretty);
}
else
fputs_filtered ("???", stream);
}
break;
case TYPE_CODE_UNION:
if (recurse && !unionprint)
{
fprintf_filtered (stream, "{...}");
break;
}
/* Fall through. */
case TYPE_CODE_STRUCT:
if (m2_is_long_set (type))
m2_print_long_set (type, valaddr, embedded_offset, address,
stream, format, pretty);
else
cp_print_value_fields (type, type, valaddr, embedded_offset,
address, stream, format,
recurse, pretty, NULL, 0);
break;
case TYPE_CODE_ENUM:
if (format)
{
print_scalar_formatted (valaddr + embedded_offset, type,
format, 0, stream);
break;
}
len = TYPE_NFIELDS (type);
val = unpack_long (type, valaddr + embedded_offset);
for (i = 0; i < len; i++)
{
QUIT;
if (val == TYPE_FIELD_BITPOS (type, i))
{
break;
}
}
if (i < len)
{
fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
}
else
{
print_longest (stream, 'd', 0, val);
}
break;
case TYPE_CODE_FUNC:
if (format)
{
print_scalar_formatted (valaddr + embedded_offset, type,
format, 0, stream);
break;
}
/* FIXME, we should consider, at least for ANSI C language, eliminating
the distinction made between FUNCs and POINTERs to FUNCs. */
fprintf_filtered (stream, "{");
type_print (type, "", stream, -1);
fprintf_filtered (stream, "} ");
/* Try to print what function it points to, and its address. */
print_address_demangle (address, stream, demangle);
break;
case TYPE_CODE_BOOL:
format = format ? format : output_format;
if (format)
print_scalar_formatted (valaddr + embedded_offset, type,
format, 0, stream);
else
{
val = unpack_long (type, valaddr + embedded_offset);
if (val == 0)
fputs_filtered ("FALSE", stream);
else if (val == 1)
fputs_filtered ("TRUE", stream);
else
fprintf_filtered (stream, "%ld)", (long int) val);
}
break;
case TYPE_CODE_RANGE:
if (TYPE_LENGTH (type) == TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
{
m2_val_print (TYPE_TARGET_TYPE (type), valaddr, embedded_offset,
address, stream, format, deref_ref, recurse, pretty);
break;
}
/* FIXME: create_range_type does not set the unsigned bit in a
range type (I think it probably should copy it from the target
type), so we won't print values which are too large to
fit in a signed integer correctly. */
/* FIXME: Doesn't handle ranges of enums correctly. (Can't just
print with the target type, though, because the size of our type
and the target type might differ). */
/* FALLTHROUGH */
case TYPE_CODE_INT:
format = format ? format : output_format;
if (format)
print_scalar_formatted (valaddr + embedded_offset, type, format,
0, stream);
else
val_print_type_code_int (type, valaddr + embedded_offset, stream);
break;
case TYPE_CODE_CHAR:
format = format ? format : output_format;
if (format)
print_scalar_formatted (valaddr + embedded_offset, type,
format, 0, stream);
else
{
val = unpack_long (type, valaddr + embedded_offset);
if (TYPE_UNSIGNED (type))
fprintf_filtered (stream, "%u", (unsigned int) val);
else
fprintf_filtered (stream, "%d", (int) val);
fputs_filtered (" ", stream);
LA_PRINT_CHAR ((unsigned char) val, stream);
}
break;
case TYPE_CODE_FLT:
if (format)
print_scalar_formatted (valaddr + embedded_offset, type,
format, 0, stream);
else
print_floating (valaddr + embedded_offset, type, stream);
break;
case TYPE_CODE_METHOD:
break;
case TYPE_CODE_BITSTRING:
case TYPE_CODE_SET:
elttype = TYPE_INDEX_TYPE (type);
CHECK_TYPEDEF (elttype);
if (TYPE_STUB (elttype))
{
fprintf_filtered (stream, _("<incomplete type>"));
gdb_flush (stream);
break;
}
else
{
struct type *range = elttype;
LONGEST low_bound, high_bound;
int i;
int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
int need_comma = 0;
if (is_bitstring)
fputs_filtered ("B'", stream);
else
fputs_filtered ("{", stream);
i = get_discrete_bounds (range, &low_bound, &high_bound);
maybe_bad_bstring:
if (i < 0)
{
fputs_filtered (_("<error value>"), stream);
goto done;
}
for (i = low_bound; i <= high_bound; i++)
{
int element = value_bit_index (type, valaddr + embedded_offset,
i);
if (element < 0)
{
i = element;
goto maybe_bad_bstring;
}
if (is_bitstring)
fprintf_filtered (stream, "%d", element);
else if (element)
{
if (need_comma)
fputs_filtered (", ", stream);
print_type_scalar (range, i, stream);
need_comma = 1;
if (i + 1 <= high_bound
&& value_bit_index (type, valaddr + embedded_offset,
++i))
{
int j = i;
fputs_filtered ("..", stream);
while (i + 1 <= high_bound
&& value_bit_index (type,
valaddr + embedded_offset,
++i))
j = i;
print_type_scalar (range, j, stream);
}
}
}
done:
if (is_bitstring)
fputs_filtered ("'", stream);
else
fputs_filtered ("}", stream);
}
break;
case TYPE_CODE_VOID:
fprintf_filtered (stream, "void");
break;
case TYPE_CODE_ERROR:
fprintf_filtered (stream, _("<error type>"));
break;
case TYPE_CODE_UNDEF:
/* This happens (without TYPE_FLAG_STUB set) on systems which don't use
dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
and no complete type for struct foo in that file. */
fprintf_filtered (stream, _("<incomplete type>"));
break;
default:
error (_("Invalid m2 type code %d in symbol table."), TYPE_CODE (type));
}
gdb_flush (stream);
return (0);
}