+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>
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
+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.
* 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
@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.
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
/* 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,
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. */
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;
};
}
+/* 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. */
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:
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;
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;
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;
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);
/* 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.
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;
+
+ 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;
- c_print_type (type, varstring, stream, show, level); /* FIXME */
+ 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, ")");
+ }
}
/* 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.
#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,
+ ¤t_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);
}
projects / binutils-gdb.git / commitdiff