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