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