gdb/m2-lang.c

   1 /* Modula 2 language support routines for GDB, the GNU debugger.
   2    Copyright 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002
   3    Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 2 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program; if not, write to the Free Software
  19    Foundation, Inc., 59 Temple Place - Suite 330,
  20    Boston, MA 02111-1307, USA.  */
  21
  22 #include "defs.h"
  23 #include "symtab.h"
  24 #include "gdbtypes.h"
  25 #include "expression.h"
  26 #include "parser-defs.h"
  27 #include "language.h"
  28 #include "m2-lang.h"
  29 #include "c-lang.h"
  30 #include "valprint.h"
  31
  32 extern void _initialize_m2_language (void);
  33 static struct type *m2_create_fundamental_type (struct objfile *, int);
  34 static void m2_printstr (struct ui_file * stream, char *string,
  35                          unsigned int length, int width,
  36                          int force_ellipses);
  37 static void m2_printchar (int, struct ui_file *);
  38 static void m2_emit_char (int, struct ui_file *, int);
  39
  40 /* Print the character C on STREAM as part of the contents of a literal
  41    string whose delimiter is QUOTER.  Note that that format for printing
  42    characters and strings is language specific.
  43    FIXME:  This is a copy of the same function from c-exp.y.  It should
  44    be replaced with a true Modula version.
  45  */
  46
  47 static void
  48 m2_emit_char (register int c, struct ui_file *stream, int quoter)
  49 {
  50
  51   c &= 0xFF;                    /* Avoid sign bit follies */
  52
  53   if (PRINT_LITERAL_FORM (c))
  54     {
  55       if (c == '\\' || c == quoter)
  56         {
  57           fputs_filtered ("\\", stream);
  58         }
  59       fprintf_filtered (stream, "%c", c);
  60     }
  61   else
  62     {
  63       switch (c)
  64         {
  65         case '\n':
  66           fputs_filtered ("\\n", stream);
  67           break;
  68         case '\b':
  69           fputs_filtered ("\\b", stream);
  70           break;
  71         case '\t':
  72           fputs_filtered ("\\t", stream);
  73           break;
  74         case '\f':
  75           fputs_filtered ("\\f", stream);
  76           break;
  77         case '\r':
  78           fputs_filtered ("\\r", stream);
  79           break;
  80         case '\033':
  81           fputs_filtered ("\\e", stream);
  82           break;
  83         case '\007':
  84           fputs_filtered ("\\a", stream);
  85           break;
  86         default:
  87           fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
  88           break;
  89         }
  90     }
  91 }
  92
  93 /* FIXME:  This is a copy of the same function from c-exp.y.  It should
  94    be replaced with a true Modula version. */
  95
  96 static void
  97 m2_printchar (int c, struct ui_file *stream)
  98 {
  99   fputs_filtered ("'", stream);
 100   LA_EMIT_CHAR (c, stream, '\'');
 101   fputs_filtered ("'", stream);
 102 }
 103
 104 /* Print the character string STRING, printing at most LENGTH characters.
 105    Printing stops early if the number hits print_max; repeat counts
 106    are printed as appropriate.  Print ellipses at the end if we
 107    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
 108    FIXME:  This is a copy of the same function from c-exp.y.  It should
 109    be replaced with a true Modula version. */
 110
 111 static void
 112 m2_printstr (struct ui_file *stream, char *string, unsigned int length,
 113              int width, int force_ellipses)
 114 {
 115   register unsigned int i;
 116   unsigned int things_printed = 0;
 117   int in_quotes = 0;
 118   int need_comma = 0;
 119   extern int inspect_it;
 120
 121   if (length == 0)
 122     {
 123       fputs_filtered ("\"\"", gdb_stdout);
 124       return;
 125     }
 126
 127   for (i = 0; i < length && things_printed < print_max; ++i)
 128     {
 129       /* Position of the character we are examining
 130          to see whether it is repeated.  */
 131       unsigned int rep1;
 132       /* Number of repetitions we have detected so far.  */
 133       unsigned int reps;
 134
 135       QUIT;
 136
 137       if (need_comma)
 138         {
 139           fputs_filtered (", ", stream);
 140           need_comma = 0;
 141         }
 142
 143       rep1 = i + 1;
 144       reps = 1;
 145       while (rep1 < length && string[rep1] == string[i])
 146         {
 147           ++rep1;
 148           ++reps;
 149         }
 150
 151       if (reps > repeat_count_threshold)
 152         {
 153           if (in_quotes)
 154             {
 155               if (inspect_it)
 156                 fputs_filtered ("\\\", ", stream);
 157               else
 158                 fputs_filtered ("\", ", stream);
 159               in_quotes = 0;
 160             }
 161           m2_printchar (string[i], stream);
 162           fprintf_filtered (stream, " <repeats %u times>", reps);
 163           i = rep1 - 1;
 164           things_printed += repeat_count_threshold;
 165           need_comma = 1;
 166         }
 167       else
 168         {
 169           if (!in_quotes)
 170             {
 171               if (inspect_it)
 172                 fputs_filtered ("\\\"", stream);
 173               else
 174                 fputs_filtered ("\"", stream);
 175               in_quotes = 1;
 176             }
 177           LA_EMIT_CHAR (string[i], stream, '"');
 178           ++things_printed;
 179         }
 180     }
 181
 182   /* Terminate the quotes if necessary.  */
 183   if (in_quotes)
 184     {
 185       if (inspect_it)
 186         fputs_filtered ("\\\"", stream);
 187       else
 188         fputs_filtered ("\"", stream);
 189     }
 190
 191   if (force_ellipses || i < length)
 192     fputs_filtered ("...", stream);
 193 }
 194
 195 /* FIXME:  This is a copy of c_create_fundamental_type(), before
 196    all the non-C types were stripped from it.  Needs to be fixed
 197    by an experienced Modula programmer. */
 198
 199 static struct type *
 200 m2_create_fundamental_type (struct objfile *objfile, int typeid)
 201 {
 202   register struct type *type = NULL;
 203
 204   switch (typeid)
 205     {
 206     default:
 207       /* FIXME:  For now, if we are asked to produce a type not in this
 208          language, create the equivalent of a C integer type with the
 209          name "<?type?>".  When all the dust settles from the type
 210          reconstruction work, this should probably become an error. */
 211       type = init_type (TYPE_CODE_INT,
 212                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 213                         0, "<?type?>", objfile);
 214       warning ("internal error: no Modula fundamental type %d", typeid);
 215       break;
 216     case FT_VOID:
 217       type = init_type (TYPE_CODE_VOID,
 218                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 219                         0, "void", objfile);
 220       break;
 221     case FT_BOOLEAN:
 222       type = init_type (TYPE_CODE_BOOL,
 223                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 224                         TYPE_FLAG_UNSIGNED, "boolean", objfile);
 225       break;
 226     case FT_STRING:
 227       type = init_type (TYPE_CODE_STRING,
 228                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 229                         0, "string", objfile);
 230       break;
 231     case FT_CHAR:
 232       type = init_type (TYPE_CODE_INT,
 233                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 234                         0, "char", objfile);
 235       break;
 236     case FT_SIGNED_CHAR:
 237       type = init_type (TYPE_CODE_INT,
 238                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 239                         0, "signed char", objfile);
 240       break;
 241     case FT_UNSIGNED_CHAR:
 242       type = init_type (TYPE_CODE_INT,
 243                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 244                         TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
 245       break;
 246     case FT_SHORT:
 247       type = init_type (TYPE_CODE_INT,
 248                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 249                         0, "short", objfile);
 250       break;
 251     case FT_SIGNED_SHORT:
 252       type = init_type (TYPE_CODE_INT,
 253                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 254                         0, "short", objfile);   /* FIXME-fnf */
 255       break;
 256     case FT_UNSIGNED_SHORT:
 257       type = init_type (TYPE_CODE_INT,
 258                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 259                         TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
 260       break;
 261     case FT_INTEGER:
 262       type = init_type (TYPE_CODE_INT,
 263                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 264                         0, "int", objfile);
 265       break;
 266     case FT_SIGNED_INTEGER:
 267       type = init_type (TYPE_CODE_INT,
 268                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 269                         0, "int", objfile);     /* FIXME -fnf */
 270       break;
 271     case FT_UNSIGNED_INTEGER:
 272       type = init_type (TYPE_CODE_INT,
 273                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 274                         TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
 275       break;
 276     case FT_FIXED_DECIMAL:
 277       type = init_type (TYPE_CODE_INT,
 278                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 279                         0, "fixed decimal", objfile);
 280       break;
 281     case FT_LONG:
 282       type = init_type (TYPE_CODE_INT,
 283                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 284                         0, "long", objfile);
 285       break;
 286     case FT_SIGNED_LONG:
 287       type = init_type (TYPE_CODE_INT,
 288                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 289                         0, "long", objfile);    /* FIXME -fnf */
 290       break;
 291     case FT_UNSIGNED_LONG:
 292       type = init_type (TYPE_CODE_INT,
 293                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 294                         TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
 295       break;
 296     case FT_LONG_LONG:
 297       type = init_type (TYPE_CODE_INT,
 298                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 299                         0, "long long", objfile);
 300       break;
 301     case FT_SIGNED_LONG_LONG:
 302       type = init_type (TYPE_CODE_INT,
 303                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 304                         0, "signed long long", objfile);
 305       break;
 306     case FT_UNSIGNED_LONG_LONG:
 307       type = init_type (TYPE_CODE_INT,
 308                         TARGET_LONG_LONG_BIT / 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   m2_parse,                     /* parser */
 420   m2_error,                     /* parser error function */
 421   evaluate_subexp_standard,
 422   m2_printchar,                 /* Print character constant */
 423   m2_printstr,                  /* function to print string constant */
 424   m2_emit_char,                 /* Function to print a single character */
 425   m2_create_fundamental_type,   /* Create fundamental type in this language */
 426   m2_print_type,                /* Print a type using appropriate syntax */
 427   m2_val_print,                 /* Print a value using appropriate syntax */
 428   c_value_print,                /* Print a top-level value */
 429   {"", "", "", ""},             /* Binary format info */
 430   {"%loB", "", "o", "B"},       /* Octal format info */
 431   {"%ld", "", "d", ""},         /* Decimal format info */
 432   {"0%lXH", "0", "X", "H"},     /* Hex format info */
 433   m2_op_print_tab,              /* expression operators for printing */
 434   0,                            /* arrays are first-class (not c-style) */
 435   0,                            /* String lower bound */
 436   &builtin_type_m2_char,        /* Type of string elements */
 437   LANG_MAGIC
 438 };
 439
 440 /* Initialization for Modula-2 */
 441
 442 void
 443 _initialize_m2_language (void)
 444 {
 445   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 446   builtin_type_m2_int =
 447     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 448                0,
 449                "INTEGER", (struct objfile *) NULL);
 450   builtin_type_m2_card =
 451     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 452                TYPE_FLAG_UNSIGNED,
 453                "CARDINAL", (struct objfile *) NULL);
 454   builtin_type_m2_real =
 455     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 456                0,
 457                "REAL", (struct objfile *) NULL);
 458   builtin_type_m2_char =
 459     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 460                TYPE_FLAG_UNSIGNED,
 461                "CHAR", (struct objfile *) NULL);
 462   builtin_type_m2_bool =
 463     init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
 464                TYPE_FLAG_UNSIGNED,
 465                "BOOLEAN", (struct objfile *) NULL);
 466
 467   add_language (&m2_language_defn);
 468 }