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 (register int c, struct ui_file *stream, int quoter)
  48 {
  49
  50   c &= 0xFF;                    /* Avoid sign bit follies */
  51
  52   if (PRINT_LITERAL_FORM (c))
  53     {
  54       if (c == '\\' || c == quoter)
  55         {
  56           fputs_filtered ("\\", stream);
  57         }
  58       fprintf_filtered (stream, "%c", c);
  59     }
  60   else
  61     {
  62       switch (c)
  63         {
  64         case '\n':
  65           fputs_filtered ("\\n", stream);
  66           break;
  67         case '\b':
  68           fputs_filtered ("\\b", stream);
  69           break;
  70         case '\t':
  71           fputs_filtered ("\\t", stream);
  72           break;
  73         case '\f':
  74           fputs_filtered ("\\f", stream);
  75           break;
  76         case '\r':
  77           fputs_filtered ("\\r", stream);
  78           break;
  79         case '\033':
  80           fputs_filtered ("\\e", stream);
  81           break;
  82         case '\007':
  83           fputs_filtered ("\\a", stream);
  84           break;
  85         default:
  86           fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
  87           break;
  88         }
  89     }
  90 }
  91
  92 /* FIXME:  This is a copy of the same function from c-exp.y.  It should
  93    be replaced with a true Modula version. */
  94
  95 static void
  96 m2_printchar (int c, struct ui_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 (struct ui_file *stream, char *string, unsigned int length,
 112              int width, int force_ellipses)
 113 {
 114   register unsigned int i;
 115   unsigned int things_printed = 0;
 116   int in_quotes = 0;
 117   int need_comma = 0;
 118   extern int inspect_it;
 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   register 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_PTR (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   {"", "", "", ""},             /* Binary format info */
 429   {"%loB", "", "o", "B"},       /* Octal format info */
 430   {"%ld", "", "d", ""},         /* Decimal format info */
 431   {"0%lXH", "0", "X", "H"},     /* Hex format info */
 432   m2_op_print_tab,              /* expression operators for printing */
 433   0,                            /* arrays are first-class (not c-style) */
 434   0,                            /* String lower bound */
 435   &builtin_type_m2_char,        /* Type of string elements */
 436   LANG_MAGIC
 437 };
 438
 439 /* Initialization for Modula-2 */
 440
 441 void
 442 _initialize_m2_language (void)
 443 {
 444   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 445   builtin_type_m2_int =
 446     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 447                0,
 448                "INTEGER", (struct objfile *) NULL);
 449   builtin_type_m2_card =
 450     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 451                TYPE_FLAG_UNSIGNED,
 452                "CARDINAL", (struct objfile *) NULL);
 453   builtin_type_m2_real =
 454     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 455                0,
 456                "REAL", (struct objfile *) NULL);
 457   builtin_type_m2_char =
 458     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 459                TYPE_FLAG_UNSIGNED,
 460                "CHAR", (struct objfile *) NULL);
 461   builtin_type_m2_bool =
 462     init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
 463                TYPE_FLAG_UNSIGNED,
 464                "BOOLEAN", (struct objfile *) NULL);
 465
 466   add_language (&m2_language_defn);
 467 }