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      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      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      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 ("\"\"", 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   register int nbytes;
 204
 205   switch (typeid)
 206     {
 207       default:
 208         /* FIXME:  For now, if we are asked to produce a type not in this
 209            language, create the equivalent of a C integer type with the
 210            name "<?type?>".  When all the dust settles from the type
 211            reconstruction work, this should probably become an error. */
 212         type = init_type (TYPE_CODE_INT,
 213                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 214                           0, "<?type?>", objfile);
 215         warning ("internal error: no Modula fundamental type %d", typeid);
 216         break;
 217       case FT_VOID:
 218         type = init_type (TYPE_CODE_VOID,
 219                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 220                           0, "void", objfile);
 221         break;
 222       case FT_BOOLEAN:
 223         type = init_type (TYPE_CODE_BOOL,
 224                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 225                           TYPE_FLAG_UNSIGNED, "boolean", objfile);
 226         break;
 227       case FT_STRING:
 228         type = init_type (TYPE_CODE_PASCAL_ARRAY,
 229                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 230                           0, "string", objfile);
 231         break;
 232       case FT_CHAR:
 233         type = init_type (TYPE_CODE_INT,
 234                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 235                           0, "char", objfile);
 236         break;
 237       case FT_SIGNED_CHAR:
 238         type = init_type (TYPE_CODE_INT,
 239                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 240                           TYPE_FLAG_SIGNED, "signed char", objfile);
 241         break;
 242       case FT_UNSIGNED_CHAR:
 243         type = init_type (TYPE_CODE_INT,
 244                           TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 245                           TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
 246         break;
 247       case FT_SHORT:
 248         type = init_type (TYPE_CODE_INT,
 249                           TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 250                           0, "short", objfile);
 251         break;
 252       case FT_SIGNED_SHORT:
 253         type = init_type (TYPE_CODE_INT,
 254                           TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 255                           TYPE_FLAG_SIGNED, "short", objfile);  /* FIXME-fnf */
 256         break;
 257       case FT_UNSIGNED_SHORT:
 258         type = init_type (TYPE_CODE_INT,
 259                           TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 260                           TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
 261         break;
 262       case FT_INTEGER:
 263         type = init_type (TYPE_CODE_INT,
 264                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 265                           0, "int", objfile);
 266         break;
 267       case FT_SIGNED_INTEGER:
 268         type = init_type (TYPE_CODE_INT,
 269                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 270                           TYPE_FLAG_SIGNED, "int", objfile); /* FIXME -fnf */
 271         break;
 272       case FT_UNSIGNED_INTEGER:
 273         type = init_type (TYPE_CODE_INT,
 274                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 275                           TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
 276         break;
 277       case FT_FIXED_DECIMAL:
 278         type = init_type (TYPE_CODE_INT,
 279                           TARGET_INT_BIT / TARGET_CHAR_BIT,
 280                           0, "fixed decimal", objfile);
 281         break;
 282       case FT_LONG:
 283         type = init_type (TYPE_CODE_INT,
 284                           TARGET_LONG_BIT / TARGET_CHAR_BIT,
 285                           0, "long", objfile);
 286         break;
 287       case FT_SIGNED_LONG:
 288         type = init_type (TYPE_CODE_INT,
 289                           TARGET_LONG_BIT / TARGET_CHAR_BIT,
 290                           TYPE_FLAG_SIGNED, "long", objfile); /* FIXME -fnf */
 291         break;
 292       case FT_UNSIGNED_LONG:
 293         type = init_type (TYPE_CODE_INT,
 294                           TARGET_LONG_BIT / TARGET_CHAR_BIT,
 295                           TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
 296         break;
 297       case FT_LONG_LONG:
 298         type = init_type (TYPE_CODE_INT,
 299                           TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 300                           0, "long long", objfile);
 301         break;
 302       case FT_SIGNED_LONG_LONG:
 303         type = init_type (TYPE_CODE_INT,
 304                           TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 305                           TYPE_FLAG_SIGNED, "signed long long", objfile);
 306         break;
 307       case FT_UNSIGNED_LONG_LONG:
 308         type = init_type (TYPE_CODE_INT,
 309                           TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 310                           TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
 311         break;
 312       case FT_FLOAT:
 313         type = init_type (TYPE_CODE_FLT,
 314                           TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 315                           0, "float", objfile);
 316         break;
 317       case FT_DBL_PREC_FLOAT:
 318         type = init_type (TYPE_CODE_FLT,
 319                           TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 320                           0, "double", objfile);
 321         break;
 322       case FT_FLOAT_DECIMAL:
 323         type = init_type (TYPE_CODE_FLT,
 324                           TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 325                           0, "floating decimal", objfile);
 326         break;
 327       case FT_EXT_PREC_FLOAT:
 328         type = init_type (TYPE_CODE_FLT,
 329                           TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 330                           0, "long double", objfile);
 331         break;
 332       case FT_COMPLEX:
 333         type = init_type (TYPE_CODE_FLT,
 334                           TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
 335                           0, "complex", objfile);
 336         break;
 337       case FT_DBL_PREC_COMPLEX:
 338         type = init_type (TYPE_CODE_FLT,
 339                           TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
 340                           0, "double complex", objfile);
 341         break;
 342       case FT_EXT_PREC_COMPLEX:
 343         type = init_type (TYPE_CODE_FLT,
 344                           TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
 345                           0, "long double complex", objfile);
 346         break;
 347       }
 348   return (type);
 349 }
 350
 351 \f
 352 /* Table of operators and their precedences for printing expressions.  */
 353
 354 const static struct op_print m2_op_print_tab[] = {
 355     {"+",   BINOP_ADD, PREC_ADD, 0},
 356     {"+",   UNOP_PLUS, PREC_PREFIX, 0},
 357     {"-",   BINOP_SUB, PREC_ADD, 0},
 358     {"-",   UNOP_NEG, PREC_PREFIX, 0},
 359     {"*",   BINOP_MUL, PREC_MUL, 0},
 360     {"/",   BINOP_DIV, PREC_MUL, 0},
 361     {"DIV", BINOP_INTDIV, PREC_MUL, 0},
 362     {"MOD", BINOP_REM, PREC_MUL, 0},
 363     {":=",  BINOP_ASSIGN, PREC_ASSIGN, 1},
 364     {"OR",  BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
 365     {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
 366     {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
 367     {"=",   BINOP_EQUAL, PREC_EQUAL, 0},
 368     {"<>",  BINOP_NOTEQUAL, PREC_EQUAL, 0},
 369     {"<=",  BINOP_LEQ, PREC_ORDER, 0},
 370     {">=",  BINOP_GEQ, PREC_ORDER, 0},
 371     {">",   BINOP_GTR, PREC_ORDER, 0},
 372     {"<",   BINOP_LESS, PREC_ORDER, 0},
 373     {"^",   UNOP_IND, PREC_PREFIX, 0},
 374     {"@",   BINOP_REPEAT, PREC_REPEAT, 0},
 375     {NULL,  0, 0, 0}
 376 };
 377 \f
 378 /* The built-in types of Modula-2.  */
 379
 380 struct type *builtin_type_m2_char;
 381 struct type *builtin_type_m2_int;
 382 struct type *builtin_type_m2_card;
 383 struct type *builtin_type_m2_real;
 384 struct type *builtin_type_m2_bool;
 385
 386 struct type ** const (m2_builtin_types[]) =
 387 {
 388   &builtin_type_m2_char,
 389   &builtin_type_m2_int,
 390   &builtin_type_m2_card,
 391   &builtin_type_m2_real,
 392   &builtin_type_m2_bool,
 393   0
 394 };
 395
 396 const struct language_defn m2_language_defn = {
 397   "modula-2",
 398   language_m2,
 399   m2_builtin_types,
 400   range_check_on,
 401   type_check_on,
 402   m2_parse,                     /* parser */
 403   m2_error,                     /* parser error function */
 404   m2_printchar,                 /* Print character constant */
 405   m2_printstr,                  /* function to print string constant */
 406   m2_create_fundamental_type,   /* Create fundamental type in this language */
 407   &builtin_type_m2_int,         /* longest signed   integral type */
 408   &builtin_type_m2_card,        /* longest unsigned integral type */
 409   &builtin_type_m2_real,        /* longest floating point type */
 410   {"",      "",   "",   ""},    /* Binary format info */
 411   {"%oB",   "",   "o",  "B"},   /* Octal format info */
 412   {"%d",    "",   "d",  ""},    /* Decimal format info */
 413   {"0%XH",  "0",  "X",  "H"},   /* Hex format info */
 414   m2_op_print_tab,              /* expression operators for printing */
 415   LANG_MAGIC
 416 };
 417
 418 /* Initialization for Modula-2 */
 419
 420 void
 421 _initialize_m2_language ()
 422 {
 423   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 424   builtin_type_m2_int =
 425     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 426                0,
 427                "INTEGER", (struct objfile *) NULL);
 428   builtin_type_m2_card =
 429     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
 430                TYPE_FLAG_UNSIGNED,
 431                "CARDINAL", (struct objfile *) NULL);
 432   builtin_type_m2_real =
 433     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 434                0,
 435                "REAL", (struct objfile *) NULL);
 436   builtin_type_m2_char =
 437     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 438                TYPE_FLAG_UNSIGNED,
 439                "CHAR", (struct objfile *) NULL);
 440   builtin_type_m2_bool =
 441     init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
 442                TYPE_FLAG_UNSIGNED,
 443                "BOOLEAN", (struct objfile *) NULL);
 444
 445   TYPE_NFIELDS(builtin_type_m2_bool) = 2;
 446   TYPE_FIELDS(builtin_type_m2_bool) =
 447      (struct field *) xmalloc (sizeof (struct field) * 2);
 448   TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
 449   TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)xmalloc(6);
 450   strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
 451   TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
 452   TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)xmalloc(5);
 453   strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
 454
 455   add_language (&m2_language_defn);
 456 }