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