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