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., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20 #include "defs.h"
  21 #include "symtab.h"
  22 #include "gdbtypes.h"
  23 #include "expression.h"
  24 #include "parser-defs.h"
  25 #include "language.h"
  26 #include "m2-lang.h"
  27 #include "c-lang.h"
  28
  29 /* Print the character C on STREAM as part of the contents of a literal
  30    string whose delimiter is QUOTER.  Note that that format for printing
  31    characters and strings is language specific.
  32    FIXME:  This is a copy of the same function from c-exp.y.  It should
  33    be replaced with a true Modula version.
  34  */
  35
  36 static void
  37 emit_char (c, stream, quoter)
  38      register int c;
  39      GDB_FILE *stream;
  40      int quoter;
  41 {
  42
  43   c &= 0xFF;                    /* Avoid sign bit follies */
  44
  45   if (PRINT_LITERAL_FORM (c))
  46     {
  47       if (c == '\\' || c == quoter)
  48         {
  49           fputs_filtered ("\\", stream);
  50         }
  51       fprintf_filtered (stream, "%c", c);
  52     }
  53   else
  54     {
  55       switch (c)
  56         {
  57         case '\n':
  58           fputs_filtered ("\\n", stream);
  59           break;
  60         case '\b':
  61           fputs_filtered ("\\b", stream);
  62           break;
  63         case '\t':
  64           fputs_filtered ("\\t", stream);
  65           break;
  66         case '\f':
  67           fputs_filtered ("\\f", stream);
  68           break;
  69         case '\r':
  70           fputs_filtered ("\\r", stream);
  71           break;
  72         case '\033':
  73           fputs_filtered ("\\e", stream);
  74           break;
  75         case '\007':
  76           fputs_filtered ("\\a", stream);
  77           break;
  78         default:
  79           fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
  80           break;
  81         }
  82     }
  83 }
  84
  85 /* FIXME:  This is a copy of the same function from c-exp.y.  It should
  86    be replaced with a true Modula version. */
  87
  88 static void
  89 m2_printchar (c, stream)
  90      int c;
  91      GDB_FILE *stream;
  92 {
  93   fputs_filtered ("'", stream);
  94   emit_char (c, stream, '\'');
  95   fputs_filtered ("'", stream);
  96 }
  97
  98 /* Print the character string STRING, printing at most LENGTH characters.
  99    Printing stops early if the number hits print_max; repeat counts
 100    are printed as appropriate.  Print ellipses at the end if we
 101    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
 102    FIXME:  This is a copy of the same function from c-exp.y.  It should
 103    be replaced with a true Modula version. */
 104
 105 static void
 106 m2_printstr (stream, string, length, force_ellipses)
 107      GDB_FILE *stream;
 108      char *string;
 109      unsigned int length;
 110      int force_ellipses;
 111 {
 112   register unsigned int i;
 113   unsigned int things_printed = 0;
 114   int in_quotes = 0;
 115   int need_comma = 0;
 116   extern int inspect_it;
 117   extern int repeat_count_threshold;
 118   extern int print_max;
 119
 120   if (length == 0)
 121     {
 122       fputs_filtered ("\"\"", gdb_stdout);
 123       return;
 124     }
 125
 126   for (i = 0; i < length && things_printed < print_max; ++i)
 127     {
 128       /* Position of the character we are examining
 129          to see whether it is repeated.  */
 130       unsigned int rep1;
 131       /* Number of repetitions we have detected so far.  */
 132       unsigned int reps;
 133
 134       QUIT;
 135
 136       if (need_comma)
 137         {
 138           fputs_filtered (", ", stream);
 139           need_comma = 0;
 140         }
 141
 142       rep1 = i + 1;
 143       reps = 1;
 144       while (rep1 < length && string[rep1] == string[i])
 145         {
 146           ++rep1;
 147           ++reps;
 148         }
 149
 150       if (reps > repeat_count_threshold)
 151         {
 152           if (in_quotes)
 153             {
 154               if (inspect_it)
 155                 fputs_filtered ("\\\", ", stream);
 156               else
 157                 fputs_filtered ("\", ", stream);
 158               in_quotes = 0;
 159             }
 160           m2_printchar (string[i], stream);
 161           fprintf_filtered (stream, " <repeats %u times>", reps);
 162           i = rep1 - 1;
 163           things_printed += repeat_count_threshold;
 164           need_comma = 1;
 165         }
 166       else
 167         {
 168           if (!in_quotes)
 169             {
 170               if (inspect_it)
 171                 fputs_filtered ("\\\"", stream);
 172               else
 173                 fputs_filtered ("\"", stream);
 174               in_quotes = 1;
 175             }
 176           emit_char (string[i], stream, '"');
 177           ++things_printed;
 178         }
 179     }
 180
 181   /* Terminate the quotes if necessary.  */
 182   if (in_quotes)
 183     {
 184       if (inspect_it)
 185         fputs_filtered ("\\\"", stream);
 186       else
 187         fputs_filtered ("\"", stream);
 188     }
 189
 190   if (force_ellipses || i < length)
 191     fputs_filtered ("...", stream);
 192 }
 193
 194 /* FIXME:  This is a copy of c_create_fundamental_type(), before
 195    all the non-C types were stripped from it.  Needs to be fixed
 196    by an experienced Modula programmer. */
 197
 198 static struct type *
 199 m2_create_fundamental_type (objfile, typeid)
 200      struct objfile *objfile;
 201      int typeid;
 202 {
 203   register struct type *type = NULL;
 204
 205   switch (typeid)
 206     {
 207       default:
 208         /* FIXME:  For now, if we are asked to produce a type not in this
 209            language, create the equivalent of a C integer type with the
 210            name "<?type?>".  When all the dust settles from the type
 211            reconstruction work, this should probably become an error. */
 212         type = init_type (TYPE_CODE_INT,
 213                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 214                           0, "<?type?>", objfile);
 215         warning ("internal error: no Modula fundamental type %d", typeid);
 216         break;
 217       case FT_VOID:
 218         type = init_type (TYPE_CODE_VOID,
 219                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 220                           0, "void", objfile);
 221         break;
 222       case FT_BOOLEAN:
 223         type = init_type (TYPE_CODE_BOOL,
 224                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 225                           TYPE_FLAG_UNSIGNED, "boolean", objfile);
 226         break;
 227       case FT_STRING:
 228         type = init_type (TYPE_CODE_STRING,
 229                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 230                           0, "string", objfile);
 231         break;
 232       case FT_CHAR:
 233         type = init_type (TYPE_CODE_INT,
 234                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 235                           0, "char", objfile);
 236         break;
 237       case FT_SIGNED_CHAR:
 238         type = init_type (TYPE_CODE_INT,
 239                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 240                           0, "signed char", objfile);
 241         break;
 242       case FT_UNSIGNED_CHAR:
 243         type = init_type (TYPE_CODE_INT,
 244                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 245                           TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
 246         break;
 247       case FT_SHORT:
 248         type = init_type (TYPE_CODE_INT,
 249                           TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 250                           0, "short", objfile);
 251         break;
 252       case FT_SIGNED_SHORT:
 253         type = init_type (TYPE_CODE_INT,
 254                           TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 255                           0, "short", objfile); /* FIXME-fnf */
 256         break;
 257       case FT_UNSIGNED_SHORT:
 258         type = init_type (TYPE_CODE_INT,
 259                           TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 260                           TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
 261         break;
 262       case FT_INTEGER:
 263         type = init_type (TYPE_CODE_INT,
 264                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 265                           0, "int", objfile);
 266         break;
 267       case FT_SIGNED_INTEGER:
 268         type = init_type (TYPE_CODE_INT,
 269                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 270                           0, "int", objfile); /* FIXME -fnf */
 271         break;
 272       case FT_UNSIGNED_INTEGER:
 273         type = init_type (TYPE_CODE_INT,
 274                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 275                           TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
 276         break;
 277       case FT_FIXED_DECIMAL:
 278         type = init_type (TYPE_CODE_INT,
 279                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 280                           0, "fixed decimal", objfile);
 281         break;
 282       case FT_LONG:
 283         type = init_type (TYPE_CODE_INT,
 284                           TARGET_LONG_BIT / TARGET_CHAR_BIT,
 285                           0, "long", objfile);
 286         break;
 287       case FT_SIGNED_LONG:
 288         type = init_type (TYPE_CODE_INT,
 289                           TARGET_LONG_BIT / TARGET_CHAR_BIT,
 290                           0, "long", objfile); /* FIXME -fnf */
 291         break;
 292       case FT_UNSIGNED_LONG:
 293         type = init_type (TYPE_CODE_INT,
 294                           TARGET_LONG_BIT / TARGET_CHAR_BIT,
 295                           TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
 296         break;
 297       case FT_LONG_LONG:
 298         type = init_type (TYPE_CODE_INT,
 299                           TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 300                           0, "long long", objfile);
 301         break;
 302       case FT_SIGNED_LONG_LONG:
 303         type = init_type (TYPE_CODE_INT,
 304                           TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 305                           0, "signed long long", objfile);
 306         break;
 307       case FT_UNSIGNED_LONG_LONG:
 308         type = init_type (TYPE_CODE_INT,
 309                           TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 310                           TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
 311         break;
 312       case FT_FLOAT:
 313         type = init_type (TYPE_CODE_FLT,
 314                           TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 315                           0, "float", objfile);
 316         break;
 317       case FT_DBL_PREC_FLOAT:
 318         type = init_type (TYPE_CODE_FLT,
 319                           TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 320                           0, "double", objfile);
 321         break;
 322       case FT_FLOAT_DECIMAL:
 323         type = init_type (TYPE_CODE_FLT,
 324                           TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 325                           0, "floating decimal", objfile);
 326         break;
 327       case FT_EXT_PREC_FLOAT:
 328         type = init_type (TYPE_CODE_FLT,
 329                           TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 330                           0, "long double", objfile);
 331         break;
 332       case FT_COMPLEX:
 333         type = init_type (TYPE_CODE_COMPLEX,
 334                           2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 335                           0, "complex", objfile);
 336         TYPE_TARGET_TYPE (type)
 337           = m2_create_fundamental_type (objfile, FT_FLOAT);
 338         break;
 339       case FT_DBL_PREC_COMPLEX:
 340         type = init_type (TYPE_CODE_COMPLEX,
 341                           2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 342                           0, "double complex", objfile);
 343         TYPE_TARGET_TYPE (type)
 344           = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
 345         break;
 346       case FT_EXT_PREC_COMPLEX:
 347         type = init_type (TYPE_CODE_COMPLEX,
 348                           2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 349                           0, "long double complex", objfile);
 350         TYPE_TARGET_TYPE (type)
 351           = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
 352         break;
 353       }
 354   return (type);
 355 }
 356
 357 \f
 358 /* Table of operators and their precedences for printing expressions.  */
 359
 360 static const struct op_print m2_op_print_tab[] = {
 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   "modula-2",
 413   language_m2,
 414   m2_builtin_types,
 415   range_check_on,
 416   type_check_on,
 417   m2_parse,                     /* parser */
 418   m2_error,                     /* parser error function */
 419   evaluate_subexp_standard,
 420   m2_printchar,                 /* Print character constant */
 421   m2_printstr,                  /* function to print string constant */
 422   m2_create_fundamental_type,   /* Create fundamental type in this language */
 423   m2_print_type,                /* Print a type using appropriate syntax */
 424   m2_val_print,                 /* Print a value using appropriate syntax */
 425   c_value_print,                /* Print a top-level value */
 426   {"",      "",   "",   ""},    /* Binary format info */
 427   {"%loB",   "",   "o",  "B"},  /* Octal format info */
 428   {"%ld",    "",   "d",  ""},   /* Decimal format info */
 429   {"0%lXH",  "0",  "X",  "H"},  /* Hex format info */
 430   m2_op_print_tab,              /* expression operators for printing */
 431   0,                            /* arrays are first-class (not c-style) */
 432   0,                            /* String lower bound */
 433   &builtin_type_m2_char,        /* Type of string elements */
 434   LANG_MAGIC
 435 };
 436
 437 /* Initialization for Modula-2 */
 438
 439 void
 440 _initialize_m2_language ()
 441 {
 442   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 443   builtin_type_m2_int =
 444     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 445                0,
 446                "INTEGER", (struct objfile *) NULL);
 447   builtin_type_m2_card =
 448     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 449                TYPE_FLAG_UNSIGNED,
 450                "CARDINAL", (struct objfile *) NULL);
 451   builtin_type_m2_real =
 452     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 453                0,
 454                "REAL", (struct objfile *) NULL);
 455   builtin_type_m2_char =
 456     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 457                TYPE_FLAG_UNSIGNED,
 458                "CHAR", (struct objfile *) NULL);
 459   builtin_type_m2_bool =
 460     init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
 461                TYPE_FLAG_UNSIGNED,
 462                "BOOLEAN", (struct objfile *) NULL);
 463
 464   add_language (&m2_language_defn);
 465 }