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