gdb/m2-lang.c

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