gdb/m2-lang.c

   1 /* Modula 2 language support routines for GDB, the GNU debugger.
   2
   3    Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
   4    2005, 2007 Free Software Foundation, Inc.
   5
   6    This file is part of GDB.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 2 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program; if not, write to the Free Software
  20    Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21    Boston, MA 02110-1301, USA.  */
  22
  23 #include "defs.h"
  24 #include "symtab.h"
  25 #include "gdbtypes.h"
  26 #include "expression.h"
  27 #include "parser-defs.h"
  28 #include "language.h"
  29 #include "m2-lang.h"
  30 #include "c-lang.h"
  31 #include "valprint.h"
  32
  33 extern void _initialize_m2_language (void);
  34 static struct type *m2_create_fundamental_type (struct objfile *, int);
  35 static void m2_printchar (int, struct ui_file *);
  36 static void m2_emit_char (int, struct ui_file *, int);
  37
  38 /* Print the character C on STREAM as part of the contents of a literal
  39    string whose delimiter is QUOTER.  Note that that format for printing
  40    characters and strings is language specific.
  41    FIXME:  This is a copy of the same function from c-exp.y.  It should
  42    be replaced with a true Modula version.
  43  */
  44
  45 static void
  46 m2_emit_char (int c, struct ui_file *stream, int quoter)
  47 {
  48
  49   c &= 0xFF;                    /* Avoid sign bit follies */
  50
  51   if (PRINT_LITERAL_FORM (c))
  52     {
  53       if (c == '\\' || c == quoter)
  54         {
  55           fputs_filtered ("\\", stream);
  56         }
  57       fprintf_filtered (stream, "%c", c);
  58     }
  59   else
  60     {
  61       switch (c)
  62         {
  63         case '\n':
  64           fputs_filtered ("\\n", stream);
  65           break;
  66         case '\b':
  67           fputs_filtered ("\\b", stream);
  68           break;
  69         case '\t':
  70           fputs_filtered ("\\t", stream);
  71           break;
  72         case '\f':
  73           fputs_filtered ("\\f", stream);
  74           break;
  75         case '\r':
  76           fputs_filtered ("\\r", stream);
  77           break;
  78         case '\033':
  79           fputs_filtered ("\\e", stream);
  80           break;
  81         case '\007':
  82           fputs_filtered ("\\a", stream);
  83           break;
  84         default:
  85           fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
  86           break;
  87         }
  88     }
  89 }
  90
  91 /* FIXME:  This is a copy of the same function from c-exp.y.  It should
  92    be replaced with a true Modula version. */
  93
  94 static void
  95 m2_printchar (int c, struct ui_file *stream)
  96 {
  97   fputs_filtered ("'", stream);
  98   LA_EMIT_CHAR (c, stream, '\'');
  99   fputs_filtered ("'", stream);
 100 }
 101
 102 /* Print the character string STRING, printing at most LENGTH characters.
 103    Printing stops early if the number hits print_max; repeat counts
 104    are printed as appropriate.  Print ellipses at the end if we
 105    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
 106    FIXME:  This is a copy of the same function from c-exp.y.  It should
 107    be replaced with a true Modula version. */
 108
 109 static void
 110 m2_printstr (struct ui_file *stream, const gdb_byte *string,
 111              unsigned int length, int width, int force_ellipses)
 112 {
 113   unsigned int i;
 114   unsigned int things_printed = 0;
 115   int in_quotes = 0;
 116   int need_comma = 0;
 117
 118   if (length == 0)
 119     {
 120       fputs_filtered ("\"\"", gdb_stdout);
 121       return;
 122     }
 123
 124   for (i = 0; i < length && things_printed < print_max; ++i)
 125     {
 126       /* Position of the character we are examining
 127          to see whether it is repeated.  */
 128       unsigned int rep1;
 129       /* Number of repetitions we have detected so far.  */
 130       unsigned int reps;
 131
 132       QUIT;
 133
 134       if (need_comma)
 135         {
 136           fputs_filtered (", ", stream);
 137           need_comma = 0;
 138         }
 139
 140       rep1 = i + 1;
 141       reps = 1;
 142       while (rep1 < length && string[rep1] == string[i])
 143         {
 144           ++rep1;
 145           ++reps;
 146         }
 147
 148       if (reps > repeat_count_threshold)
 149         {
 150           if (in_quotes)
 151             {
 152               if (inspect_it)
 153                 fputs_filtered ("\\\", ", stream);
 154               else
 155                 fputs_filtered ("\", ", stream);
 156               in_quotes = 0;
 157             }
 158           m2_printchar (string[i], stream);
 159           fprintf_filtered (stream, " <repeats %u times>", reps);
 160           i = rep1 - 1;
 161           things_printed += repeat_count_threshold;
 162           need_comma = 1;
 163         }
 164       else
 165         {
 166           if (!in_quotes)
 167             {
 168               if (inspect_it)
 169                 fputs_filtered ("\\\"", stream);
 170               else
 171                 fputs_filtered ("\"", stream);
 172               in_quotes = 1;
 173             }
 174           LA_EMIT_CHAR (string[i], stream, '"');
 175           ++things_printed;
 176         }
 177     }
 178
 179   /* Terminate the quotes if necessary.  */
 180   if (in_quotes)
 181     {
 182       if (inspect_it)
 183         fputs_filtered ("\\\"", stream);
 184       else
 185         fputs_filtered ("\"", stream);
 186     }
 187
 188   if (force_ellipses || i < length)
 189     fputs_filtered ("...", stream);
 190 }
 191
 192 /* FIXME:  This is a copy of c_create_fundamental_type(), before
 193    all the non-C types were stripped from it.  Needs to be fixed
 194    by an experienced Modula programmer. */
 195
 196 static struct type *
 197 m2_create_fundamental_type (struct objfile *objfile, int typeid)
 198 {
 199   struct type *type = NULL;
 200
 201   switch (typeid)
 202     {
 203     default:
 204       /* FIXME:  For now, if we are asked to produce a type not in this
 205          language, create the equivalent of a C integer type with the
 206          name "<?type?>".  When all the dust settles from the type
 207          reconstruction work, this should probably become an error. */
 208       type = init_type (TYPE_CODE_INT,
 209                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 210                         0, "<?type?>", objfile);
 211       warning (_("internal error: no Modula fundamental type %d"), typeid);
 212       break;
 213     case FT_VOID:
 214       type = init_type (TYPE_CODE_VOID,
 215                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 216                         0, "void", objfile);
 217       break;
 218     case FT_BOOLEAN:
 219       type = init_type (TYPE_CODE_BOOL,
 220                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 221                         TYPE_FLAG_UNSIGNED, "boolean", objfile);
 222       break;
 223     case FT_STRING:
 224       type = init_type (TYPE_CODE_STRING,
 225                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 226                         0, "string", objfile);
 227       break;
 228     case FT_CHAR:
 229       type = init_type (TYPE_CODE_INT,
 230                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 231                         0, "char", objfile);
 232       break;
 233     case FT_SIGNED_CHAR:
 234       type = init_type (TYPE_CODE_INT,
 235                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 236                         0, "signed char", objfile);
 237       break;
 238     case FT_UNSIGNED_CHAR:
 239       type = init_type (TYPE_CODE_INT,
 240                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 241                         TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
 242       break;
 243     case FT_SHORT:
 244       type = init_type (TYPE_CODE_INT,
 245                         gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
 246                         0, "short", objfile);
 247       break;
 248     case FT_SIGNED_SHORT:
 249       type = init_type (TYPE_CODE_INT,
 250                         gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
 251                         0, "short", objfile);   /* FIXME-fnf */
 252       break;
 253     case FT_UNSIGNED_SHORT:
 254       type = init_type (TYPE_CODE_INT,
 255                         gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
 256                         TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
 257       break;
 258     case FT_INTEGER:
 259       type = init_type (TYPE_CODE_INT,
 260                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 261                         0, "int", objfile);
 262       break;
 263     case FT_SIGNED_INTEGER:
 264       type = init_type (TYPE_CODE_INT,
 265                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 266                         0, "int", objfile);     /* FIXME -fnf */
 267       break;
 268     case FT_UNSIGNED_INTEGER:
 269       type = init_type (TYPE_CODE_INT,
 270                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 271                         TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
 272       break;
 273     case FT_FIXED_DECIMAL:
 274       type = init_type (TYPE_CODE_INT,
 275                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 276                         0, "fixed decimal", objfile);
 277       break;
 278     case FT_LONG:
 279       type = init_type (TYPE_CODE_INT,
 280                         gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
 281                         0, "long", objfile);
 282       break;
 283     case FT_SIGNED_LONG:
 284       type = init_type (TYPE_CODE_INT,
 285                         gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
 286                         0, "long", objfile);    /* FIXME -fnf */
 287       break;
 288     case FT_UNSIGNED_LONG:
 289       type = init_type (TYPE_CODE_INT,
 290                         gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
 291                         TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
 292       break;
 293     case FT_LONG_LONG:
 294       type = init_type (TYPE_CODE_INT,
 295                         gdbarch_long_long_bit (current_gdbarch)
 296                           / TARGET_CHAR_BIT,
 297                         0, "long long", objfile);
 298       break;
 299     case FT_SIGNED_LONG_LONG:
 300       type = init_type (TYPE_CODE_INT,
 301                         gdbarch_long_long_bit (current_gdbarch)
 302                           / TARGET_CHAR_BIT,
 303                         0, "signed long long", objfile);
 304       break;
 305     case FT_UNSIGNED_LONG_LONG:
 306       type = init_type (TYPE_CODE_INT,
 307                         gdbarch_long_long_bit (current_gdbarch)
 308                           / TARGET_CHAR_BIT,
 309                         TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
 310       break;
 311     case FT_FLOAT:
 312       type = init_type (TYPE_CODE_FLT,
 313                         gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
 314                         0, "float", objfile);
 315       break;
 316     case FT_DBL_PREC_FLOAT:
 317       type = init_type (TYPE_CODE_FLT,
 318                         gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
 319                         0, "double", objfile);
 320       break;
 321     case FT_FLOAT_DECIMAL:
 322       type = init_type (TYPE_CODE_FLT,
 323                         gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
 324                         0, "floating decimal", objfile);
 325       break;
 326     case FT_EXT_PREC_FLOAT:
 327       type = init_type (TYPE_CODE_FLT,
 328                         gdbarch_long_double_bit (current_gdbarch)
 329                           / TARGET_CHAR_BIT,
 330                         0, "long double", objfile);
 331       break;
 332     case FT_COMPLEX:
 333       type = init_type (TYPE_CODE_COMPLEX,
 334                         2 * gdbarch_float_bit (current_gdbarch)
 335                           / TARGET_CHAR_BIT,
 336                         0, "complex", objfile);
 337       TYPE_TARGET_TYPE (type)
 338         = m2_create_fundamental_type (objfile, FT_FLOAT);
 339       break;
 340     case FT_DBL_PREC_COMPLEX:
 341       type = init_type (TYPE_CODE_COMPLEX,
 342                         2 * gdbarch_double_bit (current_gdbarch)
 343                           / TARGET_CHAR_BIT,
 344                         0, "double complex", objfile);
 345       TYPE_TARGET_TYPE (type)
 346         = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
 347       break;
 348     case FT_EXT_PREC_COMPLEX:
 349       type = init_type (TYPE_CODE_COMPLEX,
 350                         2 * gdbarch_long_double_bit (current_gdbarch)
 351                           / TARGET_CHAR_BIT,
 352                         0, "long double complex", objfile);
 353       TYPE_TARGET_TYPE (type)
 354         = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
 355       break;
 356     }
 357   return (type);
 358 }
 359 \f
 360
 361 /* Table of operators and their precedences for printing expressions.  */
 362
 363 static const struct op_print m2_op_print_tab[] =
 364 {
 365   {"+", BINOP_ADD, PREC_ADD, 0},
 366   {"+", UNOP_PLUS, PREC_PREFIX, 0},
 367   {"-", BINOP_SUB, PREC_ADD, 0},
 368   {"-", UNOP_NEG, PREC_PREFIX, 0},
 369   {"*", BINOP_MUL, PREC_MUL, 0},
 370   {"/", BINOP_DIV, PREC_MUL, 0},
 371   {"DIV", BINOP_INTDIV, PREC_MUL, 0},
 372   {"MOD", BINOP_REM, PREC_MUL, 0},
 373   {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
 374   {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
 375   {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
 376   {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
 377   {"=", BINOP_EQUAL, PREC_EQUAL, 0},
 378   {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
 379   {"<=", BINOP_LEQ, PREC_ORDER, 0},
 380   {">=", BINOP_GEQ, PREC_ORDER, 0},
 381   {">", BINOP_GTR, PREC_ORDER, 0},
 382   {"<", BINOP_LESS, PREC_ORDER, 0},
 383   {"^", UNOP_IND, PREC_PREFIX, 0},
 384   {"@", BINOP_REPEAT, PREC_REPEAT, 0},
 385   {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
 386   {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
 387   {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
 388   {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
 389   {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
 390   {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
 391   {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
 392   {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
 393   {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
 394   {NULL, 0, 0, 0}
 395 };
 396 \f
 397 /* The built-in types of Modula-2.  */
 398
 399 struct type *builtin_type_m2_char;
 400 struct type *builtin_type_m2_int;
 401 struct type *builtin_type_m2_card;
 402 struct type *builtin_type_m2_real;
 403 struct type *builtin_type_m2_bool;
 404
 405 enum m2_primitive_types {
 406   m2_primitive_type_char,
 407   m2_primitive_type_int,
 408   m2_primitive_type_card,
 409   m2_primitive_type_real,
 410   m2_primitive_type_bool,
 411   nr_m2_primitive_types
 412 };
 413
 414 static void
 415 m2_language_arch_info (struct gdbarch *gdbarch,
 416                        struct language_arch_info *lai)
 417 {
 418   lai->string_char_type = builtin_type_m2_char;
 419   lai->primitive_type_vector
 420     = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
 421                               struct type *);
 422
 423   lai->primitive_type_vector [m2_primitive_type_char]
 424     = builtin_type_m2_char;
 425   lai->primitive_type_vector [m2_primitive_type_int]
 426     = builtin_type_m2_int;
 427   lai->primitive_type_vector [m2_primitive_type_card]
 428     = builtin_type_m2_card;
 429   lai->primitive_type_vector [m2_primitive_type_real]
 430     = builtin_type_m2_real;
 431   lai->primitive_type_vector [m2_primitive_type_bool]
 432     = builtin_type_m2_bool;
 433 }
 434
 435 const struct language_defn m2_language_defn =
 436 {
 437   "modula-2",
 438   language_m2,
 439   NULL,
 440   range_check_on,
 441   type_check_on,
 442   case_sensitive_on,
 443   array_row_major,
 444   &exp_descriptor_standard,
 445   m2_parse,                     /* parser */
 446   m2_error,                     /* parser error function */
 447   null_post_parser,
 448   m2_printchar,                 /* Print character constant */
 449   m2_printstr,                  /* function to print string constant */
 450   m2_emit_char,                 /* Function to print a single character */
 451   m2_create_fundamental_type,   /* Create fundamental type in this language */
 452   m2_print_type,                /* Print a type using appropriate syntax */
 453   m2_val_print,                 /* Print a value using appropriate syntax */
 454   c_value_print,                /* Print a top-level value */
 455   NULL,                         /* Language specific skip_trampoline */
 456   value_of_this,                /* value_of_this */
 457   basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
 458   basic_lookup_transparent_type,/* lookup_transparent_type */
 459   NULL,                         /* Language specific symbol demangler */
 460   NULL,                         /* Language specific class_name_from_physname */
 461   m2_op_print_tab,              /* expression operators for printing */
 462   0,                            /* arrays are first-class (not c-style) */
 463   0,                            /* String lower bound */
 464   NULL,
 465   default_word_break_characters,
 466   m2_language_arch_info,
 467   default_print_array_index,
 468   LANG_MAGIC
 469 };
 470
 471 /* Initialization for Modula-2 */
 472
 473 void
 474 _initialize_m2_language (void)
 475 {
 476   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 477   builtin_type_m2_int =
 478     init_type (TYPE_CODE_INT,
 479                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 480                0, "INTEGER", (struct objfile *) NULL);
 481   builtin_type_m2_card =
 482     init_type (TYPE_CODE_INT,
 483                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 484                TYPE_FLAG_UNSIGNED,
 485                "CARDINAL", (struct objfile *) NULL);
 486   builtin_type_m2_real =
 487     init_type (TYPE_CODE_FLT,
 488                gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
 489                0,
 490                "REAL", (struct objfile *) NULL);
 491   builtin_type_m2_char =
 492     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 493                TYPE_FLAG_UNSIGNED,
 494                "CHAR", (struct objfile *) NULL);
 495   builtin_type_m2_bool =
 496     init_type (TYPE_CODE_BOOL,
 497                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 498                TYPE_FLAG_UNSIGNED,
 499                "BOOLEAN", (struct objfile *) NULL);
 500
 501   add_language (&m2_language_defn);
 502 }