X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Fm2-lang.c;h=a8dd8addbab8c5bee93cd49f5dce26b8cccae640;hb=a68ddad51d3e6245d3bdebabbe0a43267cd72a32;hp=fd13349295a8a2e56352674b6868fb1d3832a1a6;hpb=30727aa6d12fb866494020c0b62ab265a2bdcdfe;p=deliverable%2Fbinutils-gdb.git

diff --git a/gdb/m2-lang.c b/gdb/m2-lang.c
index fd13349295..a8dd8addba 100644
--- a/gdb/m2-lang.c
+++ b/gdb/m2-lang.c
@@ -1,11 +1,13 @@
 /* Modula 2 language support routines for GDB, the GNU debugger.
-   Copyright 1992 Free Software Foundation, Inc.
+
+   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
+   2005, 2007, 2008, 2009 Free Software Foundation, Inc.
 
    This file is part of GDB.
 
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
-   the Free Software Foundation; either version 2 of the License, or
+   the Free Software Foundation; either version 3 of the License, or
    (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
@@ -14,9 +16,7 @@
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
-   along with this program; if not, write to the Free Software
-   Foundation, Inc., 59 Temple Place - Suite 330,
-   Boston, MA 02111-1307, USA.  */
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include "defs.h"
 #include "symtab.h"
@@ -26,25 +26,20 @@
 #include "language.h"
 #include "m2-lang.h"
 #include "c-lang.h"
+#include "valprint.h"
 
-extern void _initialize_m2_language PARAMS ((void));
-static struct type *m2_create_fundamental_type PARAMS ((struct objfile *, int));
-static void m2_printstr PARAMS ((GDB_FILE * stream, char *string, unsigned int length, int width, int force_ellipses));
-static void m2_printchar PARAMS ((int, GDB_FILE *));
-static void m2_emit_char PARAMS ((int, GDB_FILE *, int));
+extern void _initialize_m2_language (void);
+static void m2_printchar (int, struct ui_file *);
+static void m2_emit_char (int, struct ui_file *, int);
 
 /* Print the character C on STREAM as part of the contents of a literal
    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 (c, stream, quoter)
-     register int c;
-     GDB_FILE *stream;
-     int quoter;
+m2_emit_char (int c, struct ui_file *stream, int quoter)
 {
 
   c &= 0xFF;			/* Avoid sign bit follies */
@@ -90,12 +85,10 @@ m2_emit_char (c, stream, 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 (c, stream)
-     int c;
-     GDB_FILE *stream;
+m2_printchar (int c, struct ui_file *stream)
 {
   fputs_filtered ("'", stream);
   LA_EMIT_CHAR (c, stream, '\'');
@@ -107,23 +100,17 @@ m2_printchar (c, 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 (stream, string, length, width, force_ellipses)
-     GDB_FILE *stream;
-     char *string;
-     unsigned int length;
-     int width;
-     int force_ellipses;
+m2_printstr (struct ui_file *stream, const gdb_byte *string,
+	     unsigned int length, int width, int force_ellipses,
+	     const struct value_print_options *options)
 {
-  register unsigned int i;
+  unsigned int i;
   unsigned int things_printed = 0;
   int in_quotes = 0;
   int need_comma = 0;
-  extern int inspect_it;
-  extern int repeat_count_threshold;
-  extern int print_max;
 
   if (length == 0)
     {
@@ -131,7 +118,7 @@ m2_printstr (stream, string, length, width, force_ellipses)
       return;
     }
 
-  for (i = 0; i < length && things_printed < print_max; ++i)
+  for (i = 0; i < length && things_printed < options->print_max; ++i)
     {
       /* Position of the character we are examining
          to see whether it is repeated.  */
@@ -155,11 +142,11 @@ m2_printstr (stream, string, length, width, force_ellipses)
 	  ++reps;
 	}
 
-      if (reps > repeat_count_threshold)
+      if (reps > options->repeat_count_threshold)
 	{
 	  if (in_quotes)
 	    {
-	      if (inspect_it)
+	      if (options->inspect_it)
 		fputs_filtered ("\\\", ", stream);
 	      else
 		fputs_filtered ("\", ", stream);
@@ -168,14 +155,14 @@ m2_printstr (stream, string, length, width, force_ellipses)
 	  m2_printchar (string[i], stream);
 	  fprintf_filtered (stream, " <repeats %u times>", reps);
 	  i = rep1 - 1;
-	  things_printed += repeat_count_threshold;
+	  things_printed += options->repeat_count_threshold;
 	  need_comma = 1;
 	}
       else
 	{
 	  if (!in_quotes)
 	    {
-	      if (inspect_it)
+	      if (options->inspect_it)
 		fputs_filtered ("\\\"", stream);
 	      else
 		fputs_filtered ("\"", stream);
@@ -189,7 +176,7 @@ m2_printstr (stream, string, length, width, force_ellipses)
   /* Terminate the quotes if necessary.  */
   if (in_quotes)
     {
-      if (inspect_it)
+      if (options->inspect_it)
 	fputs_filtered ("\\\"", stream);
       else
 	fputs_filtered ("\"", stream);
@@ -199,167 +186,95 @@ m2_printstr (stream, string, length, width, force_ellipses)
     fputs_filtered ("...", stream);
 }
 
-/* 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. */
-
-static struct type *
-m2_create_fundamental_type (objfile, typeid)
-     struct objfile *objfile;
-     int typeid;
+static struct value *
+evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
+			 int *pos, enum noside noside)
 {
-  register struct type *type = NULL;
-
-  switch (typeid)
+  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_ptradd (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:
-      /* 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. */
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "<?type?>", objfile);
-      warning ("internal error: no Modula fundamental type %d", typeid);
-      break;
-    case FT_VOID:
-      type = init_type (TYPE_CODE_VOID,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "void", objfile);
-      break;
-    case FT_BOOLEAN:
-      type = init_type (TYPE_CODE_BOOL,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "boolean", objfile);
-      break;
-    case FT_STRING:
-      type = init_type (TYPE_CODE_STRING,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "string", objfile);
-      break;
-    case FT_CHAR:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "char", objfile);
-      break;
-    case FT_SIGNED_CHAR:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "signed char", objfile);
-      break;
-    case FT_UNSIGNED_CHAR:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
-      break;
-    case FT_SHORT:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			0, "short", objfile);
-      break;
-    case FT_SIGNED_SHORT:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			0, "short", objfile);	/* FIXME-fnf */
-      break;
-    case FT_UNSIGNED_SHORT:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
-      break;
-    case FT_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "int", objfile);
-      break;
-    case FT_SIGNED_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "int", objfile);	/* FIXME -fnf */
-      break;
-    case FT_UNSIGNED_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
-      break;
-    case FT_FIXED_DECIMAL:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "fixed decimal", objfile);
-      break;
-    case FT_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long", objfile);
-      break;
-    case FT_SIGNED_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long", objfile);	/* FIXME -fnf */
-      break;
-    case FT_UNSIGNED_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
-      break;
-    case FT_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long long", objfile);
-      break;
-    case FT_SIGNED_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			0, "signed long long", objfile);
-      break;
-    case FT_UNSIGNED_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
-      break;
-    case FT_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-			0, "float", objfile);
-      break;
-    case FT_DBL_PREC_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "double", objfile);
-      break;
-    case FT_FLOAT_DECIMAL:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "floating decimal", objfile);
-      break;
-    case FT_EXT_PREC_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-			TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "long double", objfile);
-      break;
-    case FT_COMPLEX:
-      type = init_type (TYPE_CODE_COMPLEX,
-			2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-			0, "complex", objfile);
-      TYPE_TARGET_TYPE (type)
-	= m2_create_fundamental_type (objfile, FT_FLOAT);
-      break;
-    case FT_DBL_PREC_COMPLEX:
-      type = init_type (TYPE_CODE_COMPLEX,
-			2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "double complex", objfile);
-      TYPE_TARGET_TYPE (type)
-	= m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
-      break;
-    case FT_EXT_PREC_COMPLEX:
-      type = init_type (TYPE_CODE_COMPLEX,
-			2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "long double complex", objfile);
-      TYPE_TARGET_TYPE (type)
-	= m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
-      break;
+      return evaluate_subexp_standard (expect_type, exp, pos, noside);
     }
-  return (type);
+
+ nosideret:
+  return value_from_longest (builtin_type_int8, (LONGEST) 1);
 }
 
 
@@ -401,76 +316,136 @@ static const struct op_print m2_op_print_tab[] =
 
 /* The built-in types of Modula-2.  */
 
-struct type *builtin_type_m2_char;
-struct type *builtin_type_m2_int;
-struct type *builtin_type_m2_card;
-struct type *builtin_type_m2_real;
-struct type *builtin_type_m2_bool;
+enum m2_primitive_types {
+  m2_primitive_type_char,
+  m2_primitive_type_int,
+  m2_primitive_type_card,
+  m2_primitive_type_real,
+  m2_primitive_type_bool,
+  nr_m2_primitive_types
+};
+
+static void
+m2_language_arch_info (struct gdbarch *gdbarch,
+		       struct language_arch_info *lai)
+{
+  const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
+
+  lai->string_char_type = builtin->builtin_char;
+  lai->primitive_type_vector
+    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
+                              struct type *);
+
+  lai->primitive_type_vector [m2_primitive_type_char]
+    = builtin->builtin_char;
+  lai->primitive_type_vector [m2_primitive_type_int]
+    = builtin->builtin_int;
+  lai->primitive_type_vector [m2_primitive_type_card]
+    = builtin->builtin_card;
+  lai->primitive_type_vector [m2_primitive_type_real]
+    = builtin->builtin_real;
+  lai->primitive_type_vector [m2_primitive_type_bool]
+    = builtin->builtin_bool;
+
+  lai->bool_type_symbol = "BOOLEAN";
+  lai->bool_type_default = builtin->builtin_bool;
+}
 
-struct type **CONST_PTR (m2_builtin_types[]) =
+const struct exp_descriptor exp_descriptor_modula2 = 
 {
-  &builtin_type_m2_char,
-    &builtin_type_m2_int,
-    &builtin_type_m2_card,
-    &builtin_type_m2_real,
-    &builtin_type_m2_bool,
-    0
+  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",
   language_m2,
-  m2_builtin_types,
   range_check_on,
   type_check_on,
+  case_sensitive_on,
+  array_row_major,
+  macro_expansion_no,
+  &exp_descriptor_modula2,
   m2_parse,			/* parser */
   m2_error,			/* parser error function */
-  evaluate_subexp_standard,
+  null_post_parser,
   m2_printchar,			/* Print character constant */
   m2_printstr,			/* function to print string constant */
   m2_emit_char,			/* Function to print a single character */
-  m2_create_fundamental_type,	/* Create fundamental type in this language */
   m2_print_type,		/* Print a type using appropriate syntax */
+  m2_print_typedef,		/* Print a typedef using appropriate syntax */
   m2_val_print,			/* Print a value using appropriate syntax */
   c_value_print,		/* Print a top-level value */
-  {"", "", "", ""},		/* Binary format info */
-  {"%loB", "", "o", "B"},	/* Octal format info */
-  {"%ld", "", "d", ""},		/* Decimal format info */
-  {"0%lXH", "0", "X", "H"},	/* Hex format info */
+  NULL,				/* Language specific skip_trampoline */
+  NULL,		                /* name_of_this */
+  basic_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal */
+  basic_lookup_transparent_type,/* lookup_transparent_type */
+  NULL,				/* Language specific symbol demangler */
+  NULL,				/* Language specific class_name_from_physname */
   m2_op_print_tab,		/* expression operators for printing */
   0,				/* arrays are first-class (not c-style) */
   0,				/* String lower bound */
-  &builtin_type_m2_char,	/* Type of string elements */
+  default_word_break_characters,
+  default_make_symbol_completion_list,
+  m2_language_arch_info,
+  default_print_array_index,
+  default_pass_by_reference,
   LANG_MAGIC
 };
 
-/* Initialization for Modula-2 */
-
-void
-_initialize_m2_language ()
+static void *
+build_m2_types (struct gdbarch *gdbarch)
 {
+  struct builtin_m2_type *builtin_m2_type
+    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
+
   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
-  builtin_type_m2_int =
-    init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-	       0,
-	       "INTEGER", (struct objfile *) NULL);
-  builtin_type_m2_card =
-    init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
+  builtin_m2_type->builtin_int =
+    init_type (TYPE_CODE_INT,
+	       gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
+	       0, "INTEGER", (struct objfile *) NULL);
+  builtin_m2_type->builtin_card =
+    init_type (TYPE_CODE_INT, 
+	       gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
 	       TYPE_FLAG_UNSIGNED,
 	       "CARDINAL", (struct objfile *) NULL);
-  builtin_type_m2_real =
-    init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
+  builtin_m2_type->builtin_real =
+    init_type (TYPE_CODE_FLT,
+	       gdbarch_float_bit (gdbarch) / TARGET_CHAR_BIT,
 	       0,
 	       "REAL", (struct objfile *) NULL);
-  builtin_type_m2_char =
+  builtin_m2_type->builtin_char =
     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 	       TYPE_FLAG_UNSIGNED,
 	       "CHAR", (struct objfile *) NULL);
-  builtin_type_m2_bool =
-    init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
+  builtin_m2_type->builtin_bool =
+    init_type (TYPE_CODE_BOOL, 
+	       gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
 	       TYPE_FLAG_UNSIGNED,
 	       "BOOLEAN", (struct objfile *) NULL);
 
+  return builtin_m2_type;
+}
+
+static struct gdbarch_data *m2_type_data;
+
+const struct builtin_m2_type *
+builtin_m2_type (struct gdbarch *gdbarch)
+{
+  return gdbarch_data (gdbarch, m2_type_data);
+}
+
+
+/* Initialization for Modula-2 */
+
+void
+_initialize_m2_language (void)
+{
+  m2_type_data = gdbarch_data_register_post_init (build_m2_types);
+
   add_language (&m2_language_defn);
 }