gdb/m2-lang.c

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