gdb/m2-lang.c

   1 /* Modula 2 language support routines for GDB, the GNU debugger.
   2
   3    Copyright 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003,
   4    2004, 2005 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., 59 Temple Place - Suite 330,
  21    Boston, MA 02111-1307, 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                         TARGET_INT_BIT / 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                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 246                         0, "short", objfile);
 247       break;
 248     case FT_SIGNED_SHORT:
 249       type = init_type (TYPE_CODE_INT,
 250                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 251                         0, "short", objfile);   /* FIXME-fnf */
 252       break;
 253     case FT_UNSIGNED_SHORT:
 254       type = init_type (TYPE_CODE_INT,
 255                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 256                         TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
 257       break;
 258     case FT_INTEGER:
 259       type = init_type (TYPE_CODE_INT,
 260                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 261                         0, "int", objfile);
 262       break;
 263     case FT_SIGNED_INTEGER:
 264       type = init_type (TYPE_CODE_INT,
 265                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 266                         0, "int", objfile);     /* FIXME -fnf */
 267       break;
 268     case FT_UNSIGNED_INTEGER:
 269       type = init_type (TYPE_CODE_INT,
 270                         TARGET_INT_BIT / 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                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 276                         0, "fixed decimal", objfile);
 277       break;
 278     case FT_LONG:
 279       type = init_type (TYPE_CODE_INT,
 280                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 281                         0, "long", objfile);
 282       break;
 283     case FT_SIGNED_LONG:
 284       type = init_type (TYPE_CODE_INT,
 285                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 286                         0, "long", objfile);    /* FIXME -fnf */
 287       break;
 288     case FT_UNSIGNED_LONG:
 289       type = init_type (TYPE_CODE_INT,
 290                         TARGET_LONG_BIT / 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                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 296                         0, "long long", objfile);
 297       break;
 298     case FT_SIGNED_LONG_LONG:
 299       type = init_type (TYPE_CODE_INT,
 300                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 301                         0, "signed long long", objfile);
 302       break;
 303     case FT_UNSIGNED_LONG_LONG:
 304       type = init_type (TYPE_CODE_INT,
 305                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 306                         TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
 307       break;
 308     case FT_FLOAT:
 309       type = init_type (TYPE_CODE_FLT,
 310                         TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 311                         0, "float", objfile);
 312       break;
 313     case FT_DBL_PREC_FLOAT:
 314       type = init_type (TYPE_CODE_FLT,
 315                         TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 316                         0, "double", objfile);
 317       break;
 318     case FT_FLOAT_DECIMAL:
 319       type = init_type (TYPE_CODE_FLT,
 320                         TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 321                         0, "floating decimal", objfile);
 322       break;
 323     case FT_EXT_PREC_FLOAT:
 324       type = init_type (TYPE_CODE_FLT,
 325                         TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 326                         0, "long double", objfile);
 327       break;
 328     case FT_COMPLEX:
 329       type = init_type (TYPE_CODE_COMPLEX,
 330                         2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 331                         0, "complex", objfile);
 332       TYPE_TARGET_TYPE (type)
 333         = m2_create_fundamental_type (objfile, FT_FLOAT);
 334       break;
 335     case FT_DBL_PREC_COMPLEX:
 336       type = init_type (TYPE_CODE_COMPLEX,
 337                         2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 338                         0, "double complex", objfile);
 339       TYPE_TARGET_TYPE (type)
 340         = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
 341       break;
 342     case FT_EXT_PREC_COMPLEX:
 343       type = init_type (TYPE_CODE_COMPLEX,
 344                         2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 345                         0, "long double complex", objfile);
 346       TYPE_TARGET_TYPE (type)
 347         = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
 348       break;
 349     }
 350   return (type);
 351 }
 352 \f
 353
 354 /* Table of operators and their precedences for printing expressions.  */
 355
 356 static const struct op_print m2_op_print_tab[] =
 357 {
 358   {"+", BINOP_ADD, PREC_ADD, 0},
 359   {"+", UNOP_PLUS, PREC_PREFIX, 0},
 360   {"-", BINOP_SUB, PREC_ADD, 0},
 361   {"-", UNOP_NEG, PREC_PREFIX, 0},
 362   {"*", BINOP_MUL, PREC_MUL, 0},
 363   {"/", BINOP_DIV, PREC_MUL, 0},
 364   {"DIV", BINOP_INTDIV, PREC_MUL, 0},
 365   {"MOD", BINOP_REM, PREC_MUL, 0},
 366   {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
 367   {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
 368   {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
 369   {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
 370   {"=", BINOP_EQUAL, PREC_EQUAL, 0},
 371   {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
 372   {"<=", BINOP_LEQ, PREC_ORDER, 0},
 373   {">=", BINOP_GEQ, PREC_ORDER, 0},
 374   {">", BINOP_GTR, PREC_ORDER, 0},
 375   {"<", BINOP_LESS, PREC_ORDER, 0},
 376   {"^", UNOP_IND, PREC_PREFIX, 0},
 377   {"@", BINOP_REPEAT, PREC_REPEAT, 0},
 378   {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
 379   {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
 380   {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
 381   {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
 382   {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
 383   {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
 384   {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
 385   {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
 386   {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
 387   {NULL, 0, 0, 0}
 388 };
 389 \f
 390 /* The built-in types of Modula-2.  */
 391
 392 struct type *builtin_type_m2_char;
 393 struct type *builtin_type_m2_int;
 394 struct type *builtin_type_m2_card;
 395 struct type *builtin_type_m2_real;
 396 struct type *builtin_type_m2_bool;
 397
 398 struct type **const (m2_builtin_types[]) =
 399 {
 400   &builtin_type_m2_char,
 401     &builtin_type_m2_int,
 402     &builtin_type_m2_card,
 403     &builtin_type_m2_real,
 404     &builtin_type_m2_bool,
 405     0
 406 };
 407
 408 const struct language_defn m2_language_defn =
 409 {
 410   "modula-2",
 411   language_m2,
 412   m2_builtin_types,
 413   range_check_on,
 414   type_check_on,
 415   case_sensitive_on,
 416   array_row_major,
 417   &exp_descriptor_standard,
 418   m2_parse,                     /* parser */
 419   m2_error,                     /* parser error function */
 420   null_post_parser,
 421   m2_printchar,                 /* Print character constant */
 422   m2_printstr,                  /* function to print string constant */
 423   m2_emit_char,                 /* Function to print a single character */
 424   m2_create_fundamental_type,   /* Create fundamental type in this language */
 425   m2_print_type,                /* Print a type using appropriate syntax */
 426   m2_val_print,                 /* Print a value using appropriate syntax */
 427   c_value_print,                /* Print a top-level value */
 428   NULL,                         /* Language specific skip_trampoline */
 429   value_of_this,                /* value_of_this */
 430   basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
 431   basic_lookup_transparent_type,/* lookup_transparent_type */
 432   NULL,                         /* Language specific symbol demangler */
 433   NULL,                         /* Language specific class_name_from_physname */
 434   m2_op_print_tab,              /* expression operators for printing */
 435   0,                            /* arrays are first-class (not c-style) */
 436   0,                            /* String lower bound */
 437   &builtin_type_m2_char,        /* Type of string elements */
 438   default_word_break_characters,
 439   NULL, /* FIXME: la_language_arch_info.  */
 440   LANG_MAGIC
 441 };
 442
 443 /* Initialization for Modula-2 */
 444
 445 void
 446 _initialize_m2_language (void)
 447 {
 448   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 449   builtin_type_m2_int =
 450     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 451                0,
 452                "INTEGER", (struct objfile *) NULL);
 453   builtin_type_m2_card =
 454     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 455                TYPE_FLAG_UNSIGNED,
 456                "CARDINAL", (struct objfile *) NULL);
 457   builtin_type_m2_real =
 458     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 459                0,
 460                "REAL", (struct objfile *) NULL);
 461   builtin_type_m2_char =
 462     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 463                TYPE_FLAG_UNSIGNED,
 464                "CHAR", (struct objfile *) NULL);
 465   builtin_type_m2_bool =
 466     init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
 467                TYPE_FLAG_UNSIGNED,
 468                "BOOLEAN", (struct objfile *) NULL);
 469
 470   add_language (&m2_language_defn);
 471 }