gdb/m2-lang.c

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