* doc/gdb.texinfo: Add TSIZE definition, removed

statement about unbounded arrays being unimplemented.
* m2-valprint.c (m2_print_array_contents):  New function.
(m2_print_unbounded_array):  New function.
(m2_print_array_contents):  New function.
* m2-typeprint.c (m2_unbounded_array):  New function.
(m2_is_unbounded_array):  New function.
(m2_print_type):  Test for unbounded array when walking
across structs.
* m2-lang.h:  Added extern m2_is_unbounded_array.
* m2-lang.c (evaluate_subexp_modula2):  New function.
(exp_descriptor_modula2):  New structure.
(m2_language_defn):  Use exp_descriptor_modula2.
* m2-exp.y:  Added TSIZE and binary subscript.

7 files changed, 290 insertions, 38 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index b13e70b..7e77809 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,20 @@
+2007-10-16  Gaius Mulley  <gaius@glam.ac.uk>
+
+        * doc/gdb.texinfo:  Add TSIZE definition, removed
+	statement about unbounded arrays being unimplemented.
+	* m2-valprint.c (m2_print_array_contents):  New function.
+	(m2_print_unbounded_array):  New function.
+	(m2_print_array_contents):  New function.
+	* m2-typeprint.c (m2_unbounded_array):  New function.
+	(m2_is_unbounded_array):  New function.
+	(m2_print_type):  Test for unbounded array when walking
+	across structs.
+	* m2-lang.h:  Added extern m2_is_unbounded_array.
+	* m2-lang.c (evaluate_subexp_modula2):  New function.
+	(exp_descriptor_modula2):  New structure.
+	(m2_language_defn):  Use exp_descriptor_modula2.
+	* m2-exp.y:  Added TSIZE and binary subscript.
+
 2007-10-16  Daniel Jacobowitz  <dan@codesourcery.com>
 
 	* mi/mi-main.c (captured_mi_execute_command): Clear mi_error_message
diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo
index f6d7e9e..61f7fee 100644
--- a/gdb/doc/gdb.texinfo
+++ b/gdb/doc/gdb.texinfo
@@ -9979,6 +9979,9 @@ Returns the size of its argument.  @var{x} can be a variable or a type.
 @item TRUNC(@var{r})
 Returns the integral part of @var{r}.
 
+@item TSIZE(@var{x})
+Returns the size of its argument.  @var{x} can be a variable or a type.
+
 @item VAL(@var{t},@var{i})
 Returns the member of the type @var{t} whose ordinal value is @var{i}.
 @end table
@@ -10109,7 +10112,7 @@ ARRAY [-10..10] OF CHAR
 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}.
+above.
 
 Here are some more type related Modula-2 examples:
 
diff --git a/gdb/m2-exp.y b/gdb/m2-exp.y
index 201ba82..7bcde3b 100644
--- a/gdb/m2-exp.y
+++ b/gdb/m2-exp.y
@@ -174,6 +174,7 @@ static struct block *modblock=0;
 %token <sval> TYPENAME
 
 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
+%token TSIZE
 %token INC DEC INCL EXCL
 
 /* The GDB scope operator */
@@ -288,6 +289,10 @@ exp	:	TRUNC '(' exp ')'
 			{ write_exp_elt_opcode (UNOP_TRUNC); }
 	;
 
+exp	:	TSIZE '(' exp ')'
+			{ write_exp_elt_opcode (UNOP_SIZEOF); }
+	;
+
 exp	:	SIZE exp       %prec UNARY
 			{ write_exp_elt_opcode (UNOP_SIZEOF); }
 	;
@@ -353,6 +358,10 @@ exp     :       exp '['
 			  write_exp_elt_opcode (MULTI_SUBSCRIPT); }
         ;
 
+exp	:	exp '[' exp ']'
+			{ write_exp_elt_opcode (BINOP_SUBSCRIPT); }
+	;
+
 exp	:	exp '('
 			/* This is to save the value of arglist_len
 			   being accumulated by an outer function call.  */
@@ -809,6 +818,7 @@ static struct keyword keytab[] =
     {"SIZE",  SIZE       },
     {"FLOAT", FLOAT_FUNC },
     {"TRUNC", TRUNC	 },
+    {"TSIZE", SIZE       },
 };
 
 
diff --git a/gdb/m2-lang.c b/gdb/m2-lang.c
index 128869c..be7eaed 100644
--- a/gdb/m2-lang.c
+++ b/gdb/m2-lang.c
@@ -37,8 +37,7 @@ static void m2_emit_char (int, struct ui_file *, int);
    string whose delimiter is QUOTER.  Note that that format for printing
    characters and strings is language specific.
    FIXME:  This is a copy of the same function from c-exp.y.  It should
-   be replaced with a true Modula version.
- */
+   be replaced with a true Modula version.  */
 
 static void
 m2_emit_char (int c, struct ui_file *stream, int quoter)
@@ -87,7 +86,7 @@ m2_emit_char (int c, struct ui_file *stream, int quoter)
 }
 
 /* FIXME:  This is a copy of the same function from c-exp.y.  It should
-   be replaced with a true Modula version. */
+   be replaced with a true Modula version.  */
 
 static void
 m2_printchar (int c, struct ui_file *stream)
@@ -102,7 +101,7 @@ m2_printchar (int c, struct ui_file *stream)
    are printed as appropriate.  Print ellipses at the end if we
    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
    FIXME:  This is a copy of the same function from c-exp.y.  It should
-   be replaced with a true Modula version. */
+   be replaced with a true Modula version.  */
 
 static void
 m2_printstr (struct ui_file *stream, const gdb_byte *string,
@@ -187,9 +186,100 @@ m2_printstr (struct ui_file *stream, const gdb_byte *string,
     fputs_filtered ("...", stream);
 }
 
+static struct value *
+evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
+			 int *pos, enum noside noside)
+{
+  enum exp_opcode op = exp->elts[*pos].opcode;
+  struct value *arg1;
+  struct value *arg2;
+  struct type *type;
+  switch (op)
+    {
+    case UNOP_HIGH:
+      (*pos)++;
+      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
+
+      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
+	return arg1;
+      else
+	{
+	  arg1 = coerce_ref (arg1);
+	  type = check_typedef (value_type (arg1));
+
+	  if (m2_is_unbounded_array (type))
+	    {
+	      struct value *temp = arg1;
+	      type = TYPE_FIELD_TYPE (type, 1);
+	      /* i18n: Do not translate the "_m2_high" part!  */
+	      arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
+				       _("unbounded structure "
+					 "missing _m2_high field"));
+	  
+	      if (value_type (arg1) != type)
+		arg1 = value_cast (type, arg1);
+	    }
+	}
+      return arg1;
+
+    case BINOP_SUBSCRIPT:
+      (*pos)++;
+      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
+      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+      if (noside == EVAL_SKIP)
+	goto nosideret;
+      /* If the user attempts to subscript something that is not an
+         array or pointer type (like a plain int variable for example),
+         then report this as an error.  */
+
+      arg1 = coerce_ref (arg1);
+      type = check_typedef (value_type (arg1));
+
+      if (m2_is_unbounded_array (type))
+	{
+	  struct value *temp = arg1;
+	  type = TYPE_FIELD_TYPE (type, 0);
+	  if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR)) {
+	    warning (_("internal error: unbounded array structure is unknown"));
+	    return evaluate_subexp_standard (expect_type, exp, pos, noside);
+	  }
+	  /* i18n: Do not translate the "_m2_contents" part!  */
+	  arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
+				   _("unbounded structure "
+				     "missing _m2_contents field"));
+	  
+	  if (value_type (arg1) != type)
+	    arg1 = value_cast (type, arg1);
+
+	  type = check_typedef (value_type (arg1));
+	  return value_ind (value_add (arg1, arg2));
+	}
+      else
+	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
+	  {
+	    if (TYPE_NAME (type))
+	      error (_("cannot subscript something of type `%s'"),
+		     TYPE_NAME (type));
+	    else
+	      error (_("cannot subscript requested type"));
+	  }
+
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
+      else
+	return value_subscript (arg1, arg2);
+
+    default:
+      return evaluate_subexp_standard (expect_type, exp, pos, noside);
+    }
+
+ nosideret:
+  return value_from_longest (builtin_type_long, (LONGEST) 1);
+}
+
 /* FIXME:  This is a copy of c_create_fundamental_type(), before
    all the non-C types were stripped from it.  Needs to be fixed
-   by an experienced Modula programmer. */
+   by an experienced Modula programmer.  */
 
 static struct type *
 m2_create_fundamental_type (struct objfile *objfile, int typeid)
@@ -202,7 +292,7 @@ m2_create_fundamental_type (struct objfile *objfile, int typeid)
       /* FIXME:  For now, if we are asked to produce a type not in this
          language, create the equivalent of a C integer type with the
          name "<?type?>".  When all the dust settles from the type
-         reconstruction work, this should probably become an error. */
+         reconstruction work, this should probably become an error.  */
       type = init_type (TYPE_CODE_INT,
 			gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 			0, "<?type?>", objfile);
@@ -426,6 +516,15 @@ m2_language_arch_info (struct gdbarch *gdbarch,
     = builtin->builtin_bool;
 }
 
+const struct exp_descriptor exp_descriptor_modula2 = 
+{
+  print_subexp_standard,
+  operator_length_standard,
+  op_name_standard,
+  dump_subexp_body_standard,
+  evaluate_subexp_modula2
+};
+
 const struct language_defn m2_language_defn =
 {
   "modula-2",
@@ -435,7 +534,7 @@ const struct language_defn m2_language_defn =
   type_check_on,
   case_sensitive_on,
   array_row_major,
-  &exp_descriptor_standard,
+  &exp_descriptor_modula2,
   m2_parse,			/* parser */
   m2_error,			/* parser error function */
   null_post_parser,
diff --git a/gdb/m2-lang.h b/gdb/m2-lang.h
index 10d2382..2e81ead 100644
--- a/gdb/m2-lang.h
+++ b/gdb/m2-lang.h
@@ -26,6 +26,7 @@ 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_is_unbounded_array (struct type *type);
 
 extern int m2_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
 			 struct ui_file *, int, int, int,
diff --git a/gdb/m2-typeprint.c b/gdb/m2-typeprint.c
index 5f76e74..244146f 100644
--- a/gdb/m2-typeprint.c
+++ b/gdb/m2-typeprint.c
@@ -53,6 +53,8 @@ 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 int m2_unbounded_array (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,
@@ -60,6 +62,7 @@ static void m2_unknown (const char *s, struct type *type,
 
 int m2_is_long_set (struct type *type);
 int m2_is_long_set_of_type (struct type *type, struct type **of_type);
+int m2_is_unbounded_array (struct type *type);
 
 
 void
@@ -88,7 +91,8 @@ m2_print_type (struct type *type, char *varstring, struct ui_file *stream,
       break;
 
     case TYPE_CODE_STRUCT:
-      if (m2_long_set (type, stream, show, level))
+      if (m2_long_set (type, stream, show, level)
+	  || m2_unbounded_array (type, stream, show, level))
 	break;
       m2_record_fields (type, stream, show, level);
       break;
@@ -150,9 +154,7 @@ m2_print_type (struct type *type, char *varstring, struct ui_file *stream,
     }
 }
 
-/*
- *  m2_type_name - if a, type, has a name then print it.
- */
+/* m2_type_name - if a, type, has a name then print it.  */
 
 void
 m2_type_name (struct type *type, struct ui_file *stream)
@@ -161,9 +163,7 @@ m2_type_name (struct type *type, struct ui_file *stream)
     fputs_filtered (TYPE_NAME (type), stream);
 }
 
-/*
- *  m2_range - displays a Modula-2 subrange type.
- */
+/* m2_range - displays a Modula-2 subrange type.  */
 
 void
 m2_range (struct type *type, struct ui_file *stream, int show,
@@ -195,9 +195,7 @@ m2_typedef (struct type *type, struct ui_file *stream, int show,
   m2_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 }
 
-/*
- *  m2_array - prints out a Modula-2 ARRAY ... OF type
- */
+/* 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)
@@ -324,9 +322,8 @@ m2_is_long_set (struct type *type)
   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
     {
 
-      /*
-       *  check if all fields of the RECORD are consecutive sets
-       */
+      /* check if all fields of the RECORD are consecutive sets.  */
+
       len = TYPE_NFIELDS (type);
       for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 	{
@@ -348,12 +345,10 @@ m2_is_long_set (struct type *type)
   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.
- */
+/* 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)
@@ -377,11 +372,9 @@ m2_get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *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.
- */
+/* 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)
@@ -472,12 +465,60 @@ m2_long_set (struct type *type, struct ui_file *stream, int show, int level)
   return 0;
 }
 
+/* m2_is_unbounded_array - returns TRUE if, type, should be regarded
+                           as a Modula-2 unbounded ARRAY type.  */
+
+int
+m2_is_unbounded_array (struct type *type)
+{
+  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+    {
+      /*
+       *  check if we have a structure with exactly two fields named
+       *  _m2_contents and _m2_high.  It also checks to see if the
+       *  type of _m2_contents is a pointer.  The TYPE_TARGET_TYPE
+       *  of the pointer determines the unbounded ARRAY OF type.
+       */
+      if (TYPE_NFIELDS (type) != 2)
+	return 0;
+      if (strcmp (TYPE_FIELD_NAME (type, 0), "_m2_contents") != 0)
+	return 0;
+      if (strcmp (TYPE_FIELD_NAME (type, 1), "_m2_high") != 0)
+	return 0;
+      if (TYPE_CODE (TYPE_FIELD_TYPE (type, 0)) != TYPE_CODE_PTR)
+	return 0;
+      return 1;
+    }
+  return 0;
+}
+
+/* m2_unbounded_array - if the struct type matches a Modula-2 unbounded
+                        parameter type then display the type as an
+                        ARRAY OF type.  Returns TRUE if an unbounded
+                        array type was detected.  */
+
+static int
+m2_unbounded_array (struct type *type, struct ui_file *stream, int show,
+		    int level)
+{
+  if (m2_is_unbounded_array (type))
+    {
+      if (show > 0)
+	{
+	  fputs_filtered ("ARRAY OF ", stream);
+	  m2_print_type (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
+			 "", stream, 0, level);
+	}
+      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. 
-   */
+  /* Print the tag if it exists.  */
   if (TYPE_TAG_NAME (type) != NULL)
     {
       if (strncmp (TYPE_TAG_NAME (type), "$$", 2) != 0)
diff --git a/gdb/m2-valprint.c b/gdb/m2-valprint.c
index 91ccafd..617208b 100644
--- a/gdb/m2-valprint.c
+++ b/gdb/m2-valprint.c
@@ -33,6 +33,12 @@
 int print_unpacked_pointer (struct type *type,
 			    CORE_ADDR address, CORE_ADDR addr,
 			    int format, struct ui_file *stream);
+static void
+m2_print_array_contents (struct type *type, const gdb_byte *valaddr,
+			 int embedded_offset, CORE_ADDR address,
+			 struct ui_file *stream, int format,
+			 enum val_prettyprint pretty,
+			 int deref_ref, int recurse, int len);
 
 
 /* Print function pointer with inferior address ADDRESS onto stdio
@@ -56,9 +62,8 @@ print_function_pointer_address (CORE_ADDR address, struct ui_file *stream)
   print_address_demangle (func_addr, stream, demangle);
 }
 
-/*
- *  get_long_set_bounds - assigns the bounds of the long set to low and high.
- */
+/* 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)
@@ -176,6 +181,36 @@ m2_print_long_set (struct type *type, const gdb_byte *valaddr,
     }
 }
 
+static void
+m2_print_unbounded_array (struct type *type, const gdb_byte *valaddr,
+			  int embedded_offset, CORE_ADDR address,
+			  struct ui_file *stream, int format,
+			  int deref_ref, enum val_prettyprint pretty,
+			  int recurse)
+{
+  struct type *content_type;
+  CORE_ADDR addr;
+  LONGEST len;
+  struct value *val;
+
+  CHECK_TYPEDEF (type);
+  content_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
+
+  addr = unpack_pointer (TYPE_FIELD_TYPE (type, 0),
+			 (TYPE_FIELD_BITPOS (type, 0) / 8) +
+			 valaddr + embedded_offset);
+
+  val = value_at_lazy (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
+		       addr);
+  len = unpack_field_as_long (type, valaddr + embedded_offset, 1);
+
+  fprintf_filtered (stream, "{");  
+  m2_print_array_contents (value_type (val), value_contents(val),
+			   value_embedded_offset (val), addr, stream,
+			   format, deref_ref, pretty, recurse, len);
+  fprintf_filtered (stream, ", HIGH = %d}", (int) len);
+}
+
 int
 print_unpacked_pointer (struct type *type,
 			CORE_ADDR address, CORE_ADDR addr,
@@ -207,7 +242,8 @@ print_unpacked_pointer (struct type *type,
 }
 
 static void
-print_variable_at_address (struct type *type, const gdb_byte *valaddr,
+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)
@@ -233,6 +269,47 @@ print_variable_at_address (struct type *type, const gdb_byte *valaddr,
     fputs_filtered ("???", stream);
 }
 
+
+/* m2_print_array_contents - prints out the contents of an
+                             array up to a max_print values.
+                             It prints arrays of char as a string
+                             and all other data types as comma
+                             separated values.  */
+
+static void
+m2_print_array_contents (struct type *type, const gdb_byte *valaddr,
+			 int embedded_offset, CORE_ADDR address,
+			 struct ui_file *stream, int format,
+			 enum val_prettyprint pretty,
+			 int deref_ref, int recurse, int len)
+{
+  int eltlen;
+  CHECK_TYPEDEF (type);
+
+  if (TYPE_LENGTH (type) > 0)
+    {
+      eltlen = TYPE_LENGTH (type);
+      if (prettyprint_arrays)
+	print_spaces_filtered (2 + 2 * recurse, stream);
+      /* For an array of chars, print with string syntax.  */
+      if (eltlen == 1 &&
+	  ((TYPE_CODE (type) == TYPE_CODE_INT)
+	   || ((current_language->la_language == language_m2)
+	       && (TYPE_CODE (type) == TYPE_CODE_CHAR)))
+	  && (format == 0 || format == 's'))
+	val_print_string (address, len+1, eltlen, stream);
+      else
+	{
+	  fprintf_filtered (stream, "{");
+	  val_print_array_elements (type, valaddr + embedded_offset,
+				    address, stream, format,
+				    deref_ref, recurse, pretty, 0);
+	  fprintf_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
@@ -364,6 +441,10 @@ m2_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
       if (m2_is_long_set (type))
 	m2_print_long_set (type, valaddr, embedded_offset, address,
 			   stream, format, pretty);
+      else if (m2_is_unbounded_array (type))
+	m2_print_unbounded_array (type, valaddr, embedded_offset,
+				  address, stream, format, deref_ref,
+				  pretty, recurse);
       else
 	cp_print_value_fields (type, type, valaddr, embedded_offset,
 			       address, stream, format,