* doc/gdb.texinfo: Add TSIZE definition, removed
authorGaius Mulley <gaius@glam.ac.uk>
Tue, 16 Oct 2007 17:36:51 +0000 (17:36 +0000)
committerGaius Mulley <gaius@glam.ac.uk>
Tue, 16 Oct 2007 17:36:51 +0000 (17:36 +0000)
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.

gdb/ChangeLog
gdb/doc/gdb.texinfo
gdb/m2-exp.y
gdb/m2-lang.c
gdb/m2-lang.h
gdb/m2-typeprint.c
gdb/m2-valprint.c

index b13e70b0cb8f3e42f6cf7ebc01338b2e3a1e8a64..7e778098aac93ad7177e0ba87f1c31b3de257d71 100644 (file)
@@ -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
index f6d7e9e32141f8648e5d59c4f7b91e6f7da2c710..61f7fee32ac82c8bf8933b6e92fe1ee33a9997d3 100644 (file)
@@ -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:
 
index 201ba8223993451d5c6f2923dec1c051bcaf60f9..7bcde3b1af7aa301f8bb1d0a13f6df9bade883ac 100644 (file)
@@ -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       },
 };
 
 
index 128869c43c15aea4e47b9a30c82f7459ca8ec648..be7eaed12856292cbefea64d838d94d390c22028 100644 (file)
@@ -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,
index 10d23826e89dc8f751e052db7efe029ac2945fa4..2e81ead3c8fa10c5afbfd979627262a55ddb5d70 100644 (file)
@@ -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,
index 5f76e74c69fe68b8b376d814386273233ef2d423..244146fe63a4875744fe59c0b13be9089a79b743 100644 (file)
@@ -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)
index 91ccafd87d6dbd89bf926d8bed4484645cbe10ca..617208bdc1598159eb77a3dda6b5e63964fabd1c 100644 (file)
 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,