Enhanced language support for Modula-2

Enhanced language support for Modula-2

[Gaius Mulley]

[-- Attachment #1: Type: text/plain, Size: 497 bytes --]


Hi,

here are the latest patches for the enhanced Modula-2 support for gdb.
In summary I've improved the documentation, rewritten m2-typeprint.c
to walk the type tree and improved m2-valprint.c to allow variables
declared at addresses to be printed using the Modula-2 syntax.

These patches can be applied to the latest gdb cvs and they don't
cause any extra regression test failures.  They compile and run
fine on Debian Etch LP64 using gcc-4.0.3.

Hope they might be useful..

regards,
Gaius



[-- Attachment #2: Modula-2 enhancements for gdb --]
[-- Type: application/octet-stream, Size: 41024 bytes --]

--- latest-cvs-gdb/src-cvs/gdb/m2-lang.h	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-lang.h	2006-04-20 12:18:17.000000000 +0100
@@ -27,6 +27,11 @@
 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);
--- latest-cvs-gdb/src-cvs/gdb/m2-typeprint.c	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-typeprint.c	2006-04-20 12:25:24.000000000 +0100
@@ -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,564 @@
    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>
 
+void m2_type_print_varspec_prefix (struct type *, struct ui_file *, int,
+				   int);
+void m2_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
+				   int show, int passed_a_ptr, int demangled_args);
+
+
+void m2_type_print_base (struct type *type, struct ui_file *stream, int show,
+			 int level);
+
+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_type_print_base (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);
 
-  c_print_type (type, varstring, stream, show, level);	/* FIXME */
+    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, ")");
+    }
+}
+
+/* Print the name of the type (or the ultimate pointer target,
+   function value or array element), or the description of a
+   structure or union.
+
+   SHOW positive means print details about the type (e.g. enum values),
+   and print structure elements passing SHOW - 1 for show.
+   SHOW negative means just print the type name or struct tag if there is one.
+   If there is no name, print something sensible but concise like
+   "struct {...}".
+   SHOW zero means just print the type name or struct tag if there is one.
+   If there is no name, print something sensible but not as concise like
+   "struct {int x; int y;}".
+
+   LEVEL is the number of spaces to indent by.
+   We increase it for some recursive calls.  */
+
+void
+m2_type_print_base (struct type *type, struct ui_file *stream, int show,
+		    int level)
+{
 }
--- latest-cvs-gdb/src-cvs/gdb/dwarf2read.c	2006-02-09 18:18:41.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/dwarf2read.c	2006-04-20 12:18:17.000000000 +0100
@@ -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_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 @@
     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 @@
     };
 }
 
+/* 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 @@
 	  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 @@
     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;
@@ -6958,6 +6982,7 @@
 	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;
@@ -7287,6 +7312,9 @@
     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;
--- latest-cvs-gdb/src-cvs/gdb/m2-valprint.c	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-valprint.c	2006-04-20 12:18:17.000000000 +0100
@@ -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,542 @@
 #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);
 }
--- latest-cvs-gdb/src-cvs/gdb/doc/gdb.texinfo	2006-04-18 01:17:55.000000000 +0100
+++ latest-cvs-gdb/src-m2/gdb/doc/gdb.texinfo	2006-04-20 12:18:17.000000000 +0100
@@ -9458,6 +9458,7 @@
 * 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
@@ -9582,7 +9583,7 @@
 @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.
@@ -9751,6 +9752,170 @@
 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:
+
+@example
+VAR
+   s: SET OF CHAR ;
+   r: [20..40] ;
+@end example
+
+@noindent
+and you can request @value{GDBN} to interrogate the type and value of
+@code{r} and @code{s}.
+
+@example
+(@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 example
+
+@noindent
+Likewise if your source code declares @code{s} as:
+
+@example
+VAR
+   s: SET ['A'..'Z'] ;
+@end example
+
+@noindent
+then you may query the type of @code{s} by:
+
+@example
+(@value{GDBP}) ptype s
+type = SET ['A'..'Z']
+@end example
+
+@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:
+
+@example
+VAR
+   s: ARRAY [-10..10] OF CHAR ;
+@end example
+
+@example
+(@value{GDBP}) ptype s
+ARRAY [-10..10] OF CHAR
+@end example
+
+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 recognised in @value{GDBN}.
+
+Here are some more type related Modula-2 examples:
+
+@example
+TYPE
+   colour = (blue, red, yellow, green) ;
+   t = [blue..yellow] ;
+VAR
+   s: t ;
+BEGIN
+   s := blue ;
+@end example
+
+@noindent
+The @value{GDBN} interaction shows how you can query the data type
+and value of a variable.
+
+@example
+(@value{GDBP}) print s
+$1 = blue
+(@value{GDBP}) ptype t
+type = [blue..yellow]
+@end example
+
+@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.
+
+@example
+VAR
+   s: ARRAY [1..5] OF CARDINAL ;
+BEGIN
+   s[1] := 1 ;
+@end example
+
+@example
+(@value{GDBP}) print s
+$1 = @{1, 0, 0, 0, 0@}
+(@value{GDBP}) ptype s
+type = ARRAY [1..5] OF CARDINAL
+@end example
+
+The Modula-2 language interface to @value{GDBN} also understands
+pointer types as shown in this example:
+
+@example
+VAR
+   s: POINTER TO ARRAY [1..5] OF CARDINAL ;
+BEGIN
+   NEW(s) ;
+   s^[1] := 1 ;
+@end example
+
+@noindent
+and you can request that @value{GDBN} describes the type of @code{s}.
+
+@example
+(@value{GDBP}) ptype s
+type = POINTER TO ARRAY [1..5] OF CARDINAL
+@end example
+
+@value{GDBN} handles compound types as we can see in this example.
+Here we combine array types, record types, pointer types and subrange
+types:
+
+@example
+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 example
+
+@noindent
+and you can ask @value{GDBN} to describe the type of @code{s} as shown
+below.
+
+@example
+(@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 example
+
 @node M2 Defaults
 @subsubsection Modula-2 defaults
 @cindex Modula-2 defaults

Re: Enhanced language support for Modula-2

[Eli Zaretskii]

> CC: jimb@red-bean.com
> From: Gaius Mulley <gaius@glam.ac.uk>
> Date: 20 Apr 2006 14:11:00 +0100
> 
> here are the latest patches for the enhanced Modula-2 support for gdb.
> In summary I've improved the documentation, rewritten m2-typeprint.c
> to walk the type tree and improved m2-valprint.c to allow variables
> declared at addresses to be printed using the Modula-2 syntax.

The doco patches are approved, but please fix the two minor gotchas
below, before you commit:

> +@example
> +VAR
> +   s: SET OF CHAR ;
> +   r: [20..40] ;
> +@end example

Please change all uses of @example to @smallexample.  We always use
@smallexample in GDB; sorry that I failed to mention this before.

> +above.  Unbounded arrays are also not yet recognised in @value{GDBN}.
                                             ^^^^^^^^^^
"recognized": we use the US spelling.

Thanks.

Re: Enhanced language support for Modula-2

[Mark Kettenis]

> Date: Thu, 20 Apr 2006 17:35:20 +0300
> From: Eli Zaretskii <eliz@gnu.org>
> 
> > CC: jimb@red-bean.com
> > From: Gaius Mulley <gaius@glam.ac.uk>
> > Date: 20 Apr 2006 14:11:00 +0100
> > 
> > here are the latest patches for the enhanced Modula-2 support for gdb.
> > In summary I've improved the documentation, rewritten m2-typeprint.c
> > to walk the type tree and improved m2-valprint.c to allow variables
> > declared at addresses to be printed using the Modula-2 syntax.
> 
> The doco patches are approved, but please fix the two minor gotchas
> below, before you commit:
> 
> > +@example
> > +VAR
> > +   s: SET OF CHAR ;
> > +   r: [20..40] ;
> > +@end example
> 
> Please change all uses of @example to @smallexample.  We always use
> @smallexample in GDB; sorry that I failed to mention this before.
> 
> > +above.  Unbounded arrays are also not yet recognised in @value{GDBN}.
>                                              ^^^^^^^^^^
> "recognized": we use the US spelling.

Oh?  I didn't know that.

Ugh Yuck!

(Sorry couldn't resist).

Re: Enhanced language support for Modula-2

[Eli Zaretskii]

> Date: Thu, 20 Apr 2006 20:47:02 +0200 (CEST)
> From: Mark Kettenis <mark.kettenis@xs4all.nl>
> CC: gaius@glam.ac.uk, gdb-patches@sources.redhat.com, jimb@red-bean.com
> 
> > "recognized": we use the US spelling.
> 
> Oh?  I didn't know that.

Well, learn something new every day.

Re: Enhanced language support for Modula-2

[Gaius Mulley]

Eli Zaretskii <eliz@gnu.org> writes:

> > CC: jimb@red-bean.com
> > From: Gaius Mulley <gaius@glam.ac.uk>
> > Date: 20 Apr 2006 14:11:00 +0100
> > 
> > here are the latest patches for the enhanced Modula-2 support for gdb.
> > In summary I've improved the documentation, rewritten m2-typeprint.c
> > to walk the type tree and improved m2-valprint.c to allow variables
> > declared at addresses to be printed using the Modula-2 syntax.
> 
> The doco patches are approved, but please fix the two minor gotchas
> below, before you commit:
> 
> > +@example
> > +VAR
> > +   s: SET OF CHAR ;
> > +   r: [20..40] ;
> > +@end example
> 
> Please change all uses of @example to @smallexample.  We always use
> @smallexample in GDB; sorry that I failed to mention this before.
> 
> > +above.  Unbounded arrays are also not yet recognised in @value{GDBN}.
>                                              ^^^^^^^^^^
> "recognized": we use the US spelling.
> 
> Thanks.

Hi Eli,

many thanks for approving the docs. Do you want me to repost the
corrected patch?  Also do you know if the code component of the patch
is/was approved?

regards,
Gaius

Re: Enhanced language support for Modula-2

[Daniel Jacobowitz]

On Thu, May 04, 2006 at 08:03:36AM +0100, Gaius Mulley wrote:
> many thanks for approving the docs. Do you want me to repost the
> corrected patch?  Also do you know if the code component of the patch
> is/was approved?

The last time you posted the patch, Jim Blandy did most of the code
review.  So I've been staying clear of it in hopes that he would look
at it again this time :-)  Jim, if you have a chance, could you look
at the new patch?

-- 
Daniel Jacobowitz
CodeSourcery

Re: Enhanced language support for Modula-2

[Jim Blandy]

On 5/4/06, Daniel Jacobowitz <drow@false.org> wrote:
> On Thu, May 04, 2006 at 08:03:36AM +0100, Gaius Mulley wrote:
> > many thanks for approving the docs. Do you want me to repost the
> > corrected patch?  Also do you know if the code component of the patch
> > is/was approved?
>
> The last time you posted the patch, Jim Blandy did most of the code
> review.  So I've been staying clear of it in hopes that he would look
> at it again this time :-)  Jim, if you have a chance, could you look
> at the new patch?

...zzz  What?  Oh, yes!  Why, an entirely rewritten Modula-2 type
printer!  Great!

The revised patch looks fine.  The only question I have is, what's up
with m2_type_print_base?  Is that the way it's supposed to be?

Re: Enhanced language support for Modula-2

[Gaius Mulley]

[-- Attachment #1: Type: text/plain, Size: 525 bytes --]

"Jim Blandy" <jimb@red-bean.com> writes:

> The revised patch looks fine.  The only question I have is, what's up
> with m2_type_print_base?  Is that the way it's supposed to be?

Hi,

thanks for the feedback and here is the revised patch - which fixes
the documentation:

    @example -> @smallexample
    @end example -> @end smallexample
    and uses the American spelling of `recogni[sz]ed'.

and the code change removes the function m2_type_print_base and
substitutes the call to it by a call to m2_print_type instead.


[-- Attachment #2: Modula-2 enhancement patch --]
[-- Type: application/octet-stream, Size: 39998 bytes --]

--- latest-cvs-gdb/src-cvs/gdb/m2-lang.h	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-lang.h	2006-04-20 12:18:17.000000000 +0100
@@ -27,6 +27,11 @@
 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);
--- latest-cvs-gdb/src-cvs/gdb/m2-typeprint.c	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-typeprint.c	2006-05-08 14:57:10.000000000 +0100
@@ -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,533 @@
    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, ")");
+    }
 }
--- latest-cvs-gdb/src-cvs/gdb/dwarf2read.c	2006-02-09 18:18:41.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/dwarf2read.c	2006-04-20 12:18:17.000000000 +0100
@@ -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_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 @@
     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 @@
     };
 }
 
+/* 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 @@
 	  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 @@
     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;
@@ -6958,6 +6982,7 @@
 	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;
@@ -7287,6 +7312,9 @@
     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;
--- latest-cvs-gdb/src-cvs/gdb/m2-valprint.c	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-valprint.c	2006-04-20 12:18:17.000000000 +0100
@@ -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,542 @@
 #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);
 }
--- latest-cvs-gdb/src-cvs/gdb/doc/gdb.texinfo	2006-04-18 01:17:55.000000000 +0100
+++ latest-cvs-gdb/src-m2/gdb/doc/gdb.texinfo	2006-05-08 14:32:03.000000000 +0100
@@ -9458,6 +9458,7 @@
 * 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
@@ -9582,7 +9583,7 @@
 @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.
@@ -9751,6 +9752,170 @@
 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

[-- Attachment #3: Type: text/plain, Size: 16 bytes --]


regards,
Gaius

Re: Enhanced language support for Modula-2

[Jim Blandy]

Gaius Mulley <gaius@glam.ac.uk> writes:
> "Jim Blandy" <jimb@red-bean.com> writes:
>
>> The revised patch looks fine.  The only question I have is, what's up
>> with m2_type_print_base?  Is that the way it's supposed to be?
>
> Hi,
>
> thanks for the feedback and here is the revised patch - which fixes
> the documentation:
>
>     @example -> @smallexample
>     @end example -> @end smallexample
>     and uses the American spelling of `recogni[sz]ed'.
>
> and the code change removes the function m2_type_print_base and
> substitutes the call to it by a call to m2_print_type instead.

Okay, just some fine-toothed comb stuff:

Have you written ChangeLog entries for this?  Follow the format the
other entries use.

In GDB code, each curly brace gets a line to itself.  I see a few
sharing a line with an 'if' or 'else' in m2-valprint.c and
m2-typeprint.c.

Also, all GNU code should fit in eighty columns.

I see some indentation problems in m2_val_print.  If you're using GNU
Emacs, just hit M-C-q before the function's opening brace, and it'll
take care of it.

Re: Enhanced language support for Modula-2

[Gaius Mulley]

[-- Attachment #1: Type: text/plain, Size: 686 bytes --]

Jim Blandy <jimb@codesourcery.com> writes:

> Have you written ChangeLog entries for this?  Follow the format the
> other entries use.
> 
> In GDB code, each curly brace gets a line to itself.  I see a few
> sharing a line with an 'if' or 'else' in m2-valprint.c and
> m2-typeprint.c.

Hi Jim and Eli,

sure ok, have done..

> Also, all GNU code should fit in eighty columns.

ok, now fixed..

> I see some indentation problems in m2_val_print.  If you're using GNU
> Emacs, just hit M-C-q before the function's opening brace, and it'll
> take care of it.

yes I use emacs for most things.. but I hadn't come across this short
cut though.. very useful and I believe all is now fixed..


[-- Attachment #2: enhanced Modula-2 mode for gdb --]
[-- Type: application/octet-stream, Size: 40349 bytes --]

--- latest-cvs-gdb/src-cvs/gdb/m2-lang.h	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-lang.h	2006-05-09 21:15:57.000000000 +0100
@@ -27,6 +27,11 @@
 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);
--- latest-cvs-gdb/src-cvs/gdb/m2-typeprint.c	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-typeprint.c	2006-05-09 22:45:54.000000000 +0100
@@ -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;
+
+  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, ")");
+    }
 }
--- latest-cvs-gdb/src-cvs/gdb/dwarf2read.c	2006-05-06 01:14:03.000000000 +0100
+++ latest-cvs-gdb/src-m2/gdb/dwarf2read.c	2006-05-09 21:15:57.000000000 +0100
@@ -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_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 @@
     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 @@
     };
 }
 
+/* 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 @@
 	  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 @@
     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 @@
 	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 @@
     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;
--- latest-cvs-gdb/src-cvs/gdb/m2-valprint.c	2005-12-17 22:34:01.000000000 +0000
+++ latest-cvs-gdb/src-m2/gdb/m2-valprint.c	2006-05-09 22:50:38.000000000 +0100
@@ -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,561 @@
 #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);
 }
--- latest-cvs-gdb/src-cvs/gdb/doc/gdb.texinfo	2006-05-05 23:48:14.000000000 +0100
+++ latest-cvs-gdb/src-m2/gdb/doc/gdb.texinfo	2006-05-09 21:15:57.000000000 +0100
@@ -9471,6 +9471,7 @@
 * 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 @@
 @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 @@
 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

[-- Attachment #3: Type: text/plain, Size: 56 bytes --]


also enclosed is a proposed set of ChangeLog entries:


[-- Attachment #4: ChangeLog entries --]
[-- Type: application/octet-stream, Size: 1394 bytes --]

2006-05-09  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.
	* gdb/doc/gdb.texinfo: added a section on Modula-2 Types.

[-- Attachment #5: Type: text/plain, Size: 16 bytes --]


regards,
Gaius

Re: Enhanced language support for Modula-2

[Jim Blandy]

Gaius Mulley <gaius@glam.ac.uk> writes:
> Jim Blandy <jimb@codesourcery.com> writes:
>
>> Have you written ChangeLog entries for this?  Follow the format the
>> other entries use.
>> 
>> In GDB code, each curly brace gets a line to itself.  I see a few
>> sharing a line with an 'if' or 'else' in m2-valprint.c and
>> m2-typeprint.c.
>
> Hi Jim and Eli,
>
> sure ok, have done..
>
>> Also, all GNU code should fit in eighty columns.
>
> ok, now fixed..
>
>> I see some indentation problems in m2_val_print.  If you're using GNU
>> Emacs, just hit M-C-q before the function's opening brace, and it'll
>> take care of it.
>
> yes I use emacs for most things.. but I hadn't come across this short
> cut though.. very useful and I believe all is now fixed..
>
>
>
> also enclosed is a proposed set of ChangeLog entries:

Looks great!

Two points to fix when you commit; don't bother re-posting the patch
for review:

- There's still an overly long line in m2-valprint.c, in the
  TYPE_CODE_STRUCT case.

- Similarly, there's a separate ChangeLog for the doc directory; the
  entry for your change to gdb.texinfo should go in gdb/doc/ChangeLog,
  not gdb/ChangeLog.  And generally, we put section names in parens
  after the filename, as we do for functions in C files.  Like so:

      * gdb.texinfo (M2 Types): New section.

I see that you have a copyright assignment on file.  Do you have
commit access to GDB?  If not, we'll have to get you set up with that
first.

If you do, then make a commit to gdb/MAINTAINERS, adding yourself to
"Write After Approval", with an appropriate ChangeLog entry.  Then go
ahead and commit the rest of the patch.

Re: Enhanced language support for Modula-2

[Gaius Mulley]

Jim Blandy <jimb@codesourcery.com> writes:

> > also enclosed is a proposed set of ChangeLog entries:
> 
> Looks great!

thanks..

> Two points to fix when you commit; don't bother re-posting the patch
> for review:
> 
> - There's still an overly long line in m2-valprint.c, in the
>   TYPE_CODE_STRUCT case.

ok I'll fix it..

> - Similarly, there's a separate ChangeLog for the doc directory; the
>   entry for your change to gdb.texinfo should go in gdb/doc/ChangeLog,
>   not gdb/ChangeLog.  And generally, we put section names in parens
>   after the filename, as we do for functions in C files.  Like so:
> 
>       * gdb.texinfo (M2 Types): New section.

ok.

> I see that you have a copyright assignment on file.  Do you have
> commit access to GDB?  If not, we'll have to get you set up with that
> first.

no I don't have commit access. Commit access would be great, thanks.

> If you do, then make a commit to gdb/MAINTAINERS, adding yourself to
> "Write After Approval", with an appropriate ChangeLog entry.  Then go
> ahead and commit the rest of the patch.

sure, will do.

regards,
Gaius

Re: Enhanced language support for Modula-2

[Joel Brobecker]

Gaius,

Even though you won't need to re-send the new patch, could you send
a small message confirming that the patch has been checked in after
you receive commit access? This is the last change I'm waiting for
before creating the 6.5 branch for the next GDB release.

Thank you,
-- 
Joel

Re: Enhanced language support for Modula-2

[Jim Blandy]

Joel Brobecker <brobecker@adacore.com> writes:
> Even though you won't need to re-send the new patch, could you send
> a small message confirming that the patch has been checked in after
> you receive commit access? This is the last change I'm waiting for
> before creating the 6.5 branch for the next GDB release.

Oh, yes: it's generally useful to post a "Committed" message after
committing an approved patch.

Re: Enhanced language support for Modula-2

[Gaius Mulley]

Jim Blandy <jimb@codesourcery.com> writes:

> Joel Brobecker <brobecker@adacore.com> writes:
> > Even though you won't need to re-send the new patch, could you send
> > a small message confirming that the patch has been checked in after
> > you receive commit access? This is the last change I'm waiting for
> > before creating the 6.5 branch for the next GDB release.
> 
> Oh, yes: it's generally useful to post a "Committed" message after
> committing an approved patch.

ok thanks, will do,

regards,
Gaius

[commit]: Re: Enhanced language support for Modula-2

[Gaius Mulley]

Hi,

a small note to say that I've applied the Modula-2 enhancement patches
to the gdb cvs.  Many thanks for all the guidance,

regards,
Gaius


2006-05-09  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.

        * gdb/doc/gdb.texinfo: added a section on Modula-2 Types.

Re: [commit]: Re: Enhanced language support for Modula-2

[Daniel Jacobowitz]

On Sat, May 13, 2006 at 04:49:49PM +0100, Gaius Mulley wrote:
> 
> Hi,
> 
> a small note to say that I've applied the Modula-2 enhancement patches
> to the gdb cvs.  Many thanks for all the guidance,

Hi Gaius,

Great to see this in.  And I see you've been working on the ChangeLog
entry.  But it still needs a bit of work, so here's some pointers (some
of these are from the GNU Coding Standards,
http://www.gnu.org/prep/standards/, others are only implicit there but
GDB tries to follow them carefully).

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

Two spaces between name and email address in the header, please.

>         * gdb/m2-lang.h: added function extern prototypes for
>         m2_is_long_set and get_long_set_bounds.

Path names should be relative to the directory containing the
ChangeLog, so just "m2-lang.h".  Entries should start with a capital
letter and end with a period (although sentence fragments are fine).

>         * gm2/m2-typeprint.c: This file has been completely
>         replaced to reflect the Modula-2 syntax rather than call the
>         c_print_type function.

We don't usually use explanatory sentences, just the actual changes; a
bit strange, yes...

>         * gdb/dwarf2read.c: added ability to detect the language
>           Modula-2 and handle SET and CHAR types.

The current version says:

        * gdb/dwarf2read.c: added ability to detect the language
        Modula-2
        and handle SET and CHAR types.

Again about the pathname and the explanatory sentences, but also the
wrapping; what's the stray newline for?

-- 
Daniel Jacobowitz
CodeSourcery

Re: [commit]: Re: Enhanced language support for Modula-2

[Gaius Mulley]

Daniel Jacobowitz <drow@false.org> writes:

> On Sat, May 13, 2006 at 04:49:49PM +0100, Gaius Mulley wrote:
> > 
> > Hi,
> > 
> > a small note to say that I've applied the Modula-2 enhancement patches
> > to the gdb cvs.  Many thanks for all the guidance,
> 
> Hi Gaius,
> 
> Great to see this in.  And I see you've been working on the ChangeLog
> entry.  But it still needs a bit of work, so here's some pointers (some
> of these are from the GNU Coding Standards,
> http://www.gnu.org/prep/standards/, others are only implicit there but
> GDB tries to follow them carefully).

Hi,

many thanks for the pointers!  I believe I've fixed all these now..

> Two spaces between name and email address in the header, please.

done

> Path names should be relative to the directory containing the
> ChangeLog, so just "m2-lang.h".  Entries should start with a capital
> letter and end with a period (although sentence fragments are fine).

done

> We don't usually use explanatory sentences, just the actual changes; a
> bit strange, yes...

ok, removed lengthy descriptions concerning changes..

> The current version says:
> 
>         * gdb/dwarf2read.c: added ability to detect the language
>         Modula-2
>         and handle SET and CHAR types.
> 
> Again about the pathname and the explanatory sentences, but also the
> wrapping; what's the stray newline for?

and removed typo..

regards,
Gaius

Re: [commit]: Re: Enhanced language support for Modula-2

[Daniel Jacobowitz]

On Sat, May 13, 2006 at 07:38:27PM +0100, Gaius Mulley wrote:
> many thanks for the pointers!  I believe I've fixed all these now..

Thanks - it looks good.  Could you also fix this one:

> > Two spaces between name and email address in the header, please.

for doc/ChangeLog?

-- 
Daniel Jacobowitz
CodeSourcery

Re: [commit]: Re: Enhanced language support for Modula-2

[Gaius Mulley]

Daniel Jacobowitz <drow@false.org> writes:

> On Sat, May 13, 2006 at 07:38:27PM +0100, Gaius Mulley wrote:
> > many thanks for the pointers!  I believe I've fixed all these now..
> 
> Thanks - it looks good.  Could you also fix this one:
> 
> > > Two spaces between name and email address in the header, please.
> 
> for doc/ChangeLog?

ahh yes, sorry, done now..

regards,
Gaius

Re: Enhanced language support for Modula-2

[Gaius Mulley]

Joel Brobecker <brobecker@adacore.com> writes:

> Gaius,
> 
> Even though you won't need to re-send the new patch, could you send
> a small message confirming that the patch has been checked in after
> you receive commit access? This is the last change I'm waiting for
> before creating the 6.5 branch for the next GDB release.
> 
> Thank you,
> -- 
> Joel

Hi Joel,

sure will do.. hopefully later today..

regards,
Gaius

Re: Enhanced language support for Modula-2

[Eli Zaretskii]

> From: Gaius Mulley <gaius@glam.ac.uk>
> Date: 08 May 2006 14:55:08 +0100
> 
> thanks for the feedback and here is the revised patch - which fixes
> the documentation:
> 
>     @example -> @smallexample
>     @end example -> @end smallexample
>     and uses the American spelling of `recogni[sz]ed'.
> 
> and the code change removes the function m2_type_print_base and
> substitutes the call to it by a call to m2_print_type instead.

The documentation part is okay with me.  Thanks.

Re: Enhanced language support for Modula-2

[Eli Zaretskii]

> Cc: gdb-patches@sources.redhat.com,  jimb@red-bean.com
> From: Gaius Mulley <gaius@glam.ac.uk>
> Date: 04 May 2006 08:03:36 +0100
> 
> many thanks for approving the docs. Do you want me to repost the
> corrected patch?

Yes, please.

> Also do you know if the code component of the patch is/was approved?

I don't remember, but you could search the mailing list archives to
find out.