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                         TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 314                         0, "float", objfile);
 315       break;
 316     case FT_DBL_PREC_FLOAT:
 317       type = init_type (TYPE_CODE_FLT,
 318                         TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 319                         0, "double", objfile);
 320       break;
 321     case FT_FLOAT_DECIMAL:
 322       type = init_type (TYPE_CODE_FLT,
 323                         TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 324                         0, "floating decimal", objfile);
 325       break;
 326     case FT_EXT_PREC_FLOAT:
 327       type = init_type (TYPE_CODE_FLT,
 328                         TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 329                         0, "long double", objfile);
 330       break;
 331     case FT_COMPLEX:
 332       type = init_type (TYPE_CODE_COMPLEX,
 333                         2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 334                         0, "complex", objfile);
 335       TYPE_TARGET_TYPE (type)
 336         = m2_create_fundamental_type (objfile, FT_FLOAT);
 337       break;
 338     case FT_DBL_PREC_COMPLEX:
 339       type = init_type (TYPE_CODE_COMPLEX,
 340                         2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 341                         0, "double complex", objfile);
 342       TYPE_TARGET_TYPE (type)
 343         = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
 344       break;
 345     case FT_EXT_PREC_COMPLEX:
 346       type = init_type (TYPE_CODE_COMPLEX,
 347                         2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 348                         0, "long double complex", objfile);
 349       TYPE_TARGET_TYPE (type)
 350         = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
 351       break;
 352     }
 353   return (type);
 354 }
 355 \f
 356
 357 /* Table of operators and their precedences for printing expressions.  */
 358
 359 static const struct op_print m2_op_print_tab[] =
 360 {
 361   {"+", BINOP_ADD, PREC_ADD, 0},
 362   {"+", UNOP_PLUS, PREC_PREFIX, 0},
 363   {"-", BINOP_SUB, PREC_ADD, 0},
 364   {"-", UNOP_NEG, PREC_PREFIX, 0},
 365   {"*", BINOP_MUL, PREC_MUL, 0},
 366   {"/", BINOP_DIV, PREC_MUL, 0},
 367   {"DIV", BINOP_INTDIV, PREC_MUL, 0},
 368   {"MOD", BINOP_REM, PREC_MUL, 0},
 369   {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
 370   {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
 371   {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
 372   {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
 373   {"=", BINOP_EQUAL, PREC_EQUAL, 0},
 374   {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
 375   {"<=", BINOP_LEQ, PREC_ORDER, 0},
 376   {">=", BINOP_GEQ, PREC_ORDER, 0},
 377   {">", BINOP_GTR, PREC_ORDER, 0},
 378   {"<", BINOP_LESS, PREC_ORDER, 0},
 379   {"^", UNOP_IND, PREC_PREFIX, 0},
 380   {"@", BINOP_REPEAT, PREC_REPEAT, 0},
 381   {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
 382   {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
 383   {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
 384   {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
 385   {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
 386   {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
 387   {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
 388   {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
 389   {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
 390   {NULL, 0, 0, 0}
 391 };
 392 \f
 393 /* The built-in types of Modula-2.  */
 394
 395 struct type *builtin_type_m2_char;
 396 struct type *builtin_type_m2_int;
 397 struct type *builtin_type_m2_card;
 398 struct type *builtin_type_m2_real;
 399 struct type *builtin_type_m2_bool;
 400
 401 struct type **const (m2_builtin_types[]) =
 402 {
 403   &builtin_type_m2_char,
 404     &builtin_type_m2_int,
 405     &builtin_type_m2_card,
 406     &builtin_type_m2_real,
 407     &builtin_type_m2_bool,
 408     0
 409 };
 410
 411 const struct language_defn m2_language_defn =
 412 {
 413   "modula-2",
 414   language_m2,
 415   m2_builtin_types,
 416   range_check_on,
 417   type_check_on,
 418   case_sensitive_on,
 419   array_row_major,
 420   &exp_descriptor_standard,
 421   m2_parse,                     /* parser */
 422   m2_error,                     /* parser error function */
 423   null_post_parser,
 424   m2_printchar,                 /* Print character constant */
 425   m2_printstr,                  /* function to print string constant */
 426   m2_emit_char,                 /* Function to print a single character */
 427   m2_create_fundamental_type,   /* Create fundamental type in this language */
 428   m2_print_type,                /* Print a type using appropriate syntax */
 429   m2_val_print,                 /* Print a value using appropriate syntax */
 430   c_value_print,                /* Print a top-level value */
 431   NULL,                         /* Language specific skip_trampoline */
 432   value_of_this,                /* value_of_this */
 433   basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
 434   basic_lookup_transparent_type,/* lookup_transparent_type */
 435   NULL,                         /* Language specific symbol demangler */
 436   NULL,                         /* Language specific class_name_from_physname */
 437   m2_op_print_tab,              /* expression operators for printing */
 438   0,                            /* arrays are first-class (not c-style) */
 439   0,                            /* String lower bound */
 440   &builtin_type_m2_char,        /* Type of string elements */
 441   default_word_break_characters,
 442   NULL, /* FIXME: la_language_arch_info.  */
 443   default_print_array_index,
 444   LANG_MAGIC
 445 };
 446
 447 /* Initialization for Modula-2 */
 448
 449 void
 450 _initialize_m2_language (void)
 451 {
 452   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 453   builtin_type_m2_int =
 454     init_type (TYPE_CODE_INT,
 455                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 456                0, "INTEGER", (struct objfile *) NULL);
 457   builtin_type_m2_card =
 458     init_type (TYPE_CODE_INT,
 459                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 460                TYPE_FLAG_UNSIGNED,
 461                "CARDINAL", (struct objfile *) NULL);
 462   builtin_type_m2_real =
 463     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 464                0,
 465                "REAL", (struct objfile *) NULL);
 466   builtin_type_m2_char =
 467     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 468                TYPE_FLAG_UNSIGNED,
 469                "CHAR", (struct objfile *) NULL);
 470   builtin_type_m2_bool =
 471     init_type (TYPE_CODE_BOOL,
 472                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 473                TYPE_FLAG_UNSIGNED,
 474                "BOOLEAN", (struct objfile *) NULL);
 475
 476   add_language (&m2_language_defn);
 477 }