gdb/p-lang.c

   1 /* Pascal language support routines for GDB, the GNU debugger.
   2    Copyright 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, Boston, MA 02111-1307, USA.  */
  19
  20 /* This file is derived from p-lang.c */
  21
  22 #include "defs.h"
  23 #include "symtab.h"
  24 #include "gdbtypes.h"
  25 #include "expression.h"
  26 #include "parser-defs.h"
  27 #include "language.h"
  28 #include "p-lang.h"
  29 #include "valprint.h"
  30
  31 extern void _initialize_pascal_language (void);
  32 static void pascal_one_char (int, struct ui_file *, int *);
  33
  34 /* Print the character C on STREAM as part of the contents of a literal
  35    string.
  36    In_quotes is reset to 0 if a char is written with #4 notation */
  37
  38 static void
  39 pascal_one_char (c, stream, in_quotes)
  40      register int c;
  41      struct ui_file *stream;
  42      int *in_quotes;
  43 {
  44
  45   c &= 0xFF;                    /* Avoid sign bit follies */
  46
  47   if ((c == '\'') || (PRINT_LITERAL_FORM (c)))
  48     {
  49       if (!(*in_quotes))
  50         fputs_filtered ("'", stream);
  51       *in_quotes = 1;
  52       if (c == '\'')
  53         {
  54           fputs_filtered ("''", stream);
  55         }
  56       else
  57         fprintf_filtered (stream, "%c", c);
  58     }
  59   else
  60     {
  61       if (*in_quotes)
  62         fputs_filtered ("'", stream);
  63       *in_quotes = 0;
  64       fprintf_filtered (stream, "#%d", (unsigned int) c);
  65     }
  66 }
  67
  68 static void pascal_emit_char (int c, struct ui_file *stream, int quoter);
  69
  70 /* Print the character C on STREAM as part of the contents of a literal
  71    string whose delimiter is QUOTER.  Note that that format for printing
  72    characters and strings is language specific. */
  73
  74 static void
  75 pascal_emit_char (c, stream, quoter)
  76      register int c;
  77      struct ui_file *stream;
  78      int quoter;
  79 {
  80   int in_quotes = 0;
  81   pascal_one_char (c, stream, &in_quotes);
  82   if (in_quotes)
  83     fputs_filtered ("'", stream);
  84 }
  85
  86 void
  87 pascal_printchar (c, stream)
  88      int c;
  89      struct ui_file *stream;
  90 {
  91   int in_quotes = 0;
  92   pascal_one_char (c, stream, &in_quotes);
  93   if (in_quotes)
  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
 102 void
 103 pascal_printstr (stream, string, length, width, force_ellipses)
 104      struct ui_file *stream;
 105      char *string;
 106      unsigned int length;
 107      int width;
 108      int force_ellipses;
 109 {
 110   register unsigned int i;
 111   unsigned int things_printed = 0;
 112   int in_quotes = 0;
 113   int need_comma = 0;
 114   extern int inspect_it;
 115
 116   /* If the string was not truncated due to `set print elements', and
 117      the last byte of it is a null, we don't print that, in traditional C
 118      style.  */
 119   if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
 120     length--;
 121
 122   if (length == 0)
 123     {
 124       fputs_filtered ("''", stream);
 125       return;
 126     }
 127
 128   for (i = 0; i < length && things_printed < print_max; ++i)
 129     {
 130       /* Position of the character we are examining
 131          to see whether it is repeated.  */
 132       unsigned int rep1;
 133       /* Number of repetitions we have detected so far.  */
 134       unsigned int reps;
 135
 136       QUIT;
 137
 138       if (need_comma)
 139         {
 140           fputs_filtered (", ", stream);
 141           need_comma = 0;
 142         }
 143
 144       rep1 = i + 1;
 145       reps = 1;
 146       while (rep1 < length && string[rep1] == string[i])
 147         {
 148           ++rep1;
 149           ++reps;
 150         }
 151
 152       if (reps > repeat_count_threshold)
 153         {
 154           if (in_quotes)
 155             {
 156               if (inspect_it)
 157                 fputs_filtered ("\\', ", stream);
 158               else
 159                 fputs_filtered ("', ", stream);
 160               in_quotes = 0;
 161             }
 162           pascal_printchar (string[i], stream);
 163           fprintf_filtered (stream, " <repeats %u times>", reps);
 164           i = rep1 - 1;
 165           things_printed += repeat_count_threshold;
 166           need_comma = 1;
 167         }
 168       else
 169         {
 170           int c = string[i];
 171           if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
 172             {
 173               if (inspect_it)
 174                 fputs_filtered ("\\'", stream);
 175               else
 176                 fputs_filtered ("'", stream);
 177               in_quotes = 1;
 178             }
 179           pascal_one_char (c, stream, &in_quotes);
 180           ++things_printed;
 181         }
 182     }
 183
 184   /* Terminate the quotes if necessary.  */
 185   if (in_quotes)
 186     {
 187       if (inspect_it)
 188         fputs_filtered ("\\'", stream);
 189       else
 190         fputs_filtered ("'", stream);
 191     }
 192
 193   if (force_ellipses || i < length)
 194     fputs_filtered ("...", stream);
 195 }
 196
 197 /* Create a fundamental Pascal type using default reasonable for the current
 198    target machine.
 199
 200    Some object/debugging file formats (DWARF version 1, COFF, etc) do not
 201    define fundamental types such as "int" or "double".  Others (stabs or
 202    DWARF version 2, etc) do define fundamental types.  For the formats which
 203    don't provide fundamental types, gdb can create such types using this
 204    function.
 205
 206    FIXME:  Some compilers distinguish explicitly signed integral types
 207    (signed short, signed int, signed long) from "regular" integral types
 208    (short, int, long) in the debugging information.  There is some dis-
 209    agreement as to how useful this feature is.  In particular, gcc does
 210    not support this.  Also, only some debugging formats allow the
 211    distinction to be passed on to a debugger.  For now, we always just
 212    use "short", "int", or "long" as the type name, for both the implicit
 213    and explicitly signed types.  This also makes life easier for the
 214    gdb test suite since we don't have to account for the differences
 215    in output depending upon what the compiler and debugging format
 216    support.  We will probably have to re-examine the issue when gdb
 217    starts taking it's fundamental type information directly from the
 218    debugging information supplied by the compiler.  fnf@cygnus.com */
 219
 220 /* Note there might be some discussion about the choosen correspondance
 221    because it mainly reflects Free Pascal Compiler setup for now PM */
 222
 223
 224 struct type *
 225 pascal_create_fundamental_type (objfile, typeid)
 226      struct objfile *objfile;
 227      int typeid;
 228 {
 229   register struct type *type = NULL;
 230
 231   switch (typeid)
 232     {
 233     default:
 234       /* FIXME:  For now, if we are asked to produce a type not in this
 235          language, create the equivalent of a C integer type with the
 236          name "<?type?>".  When all the dust settles from the type
 237          reconstruction work, this should probably become an error. */
 238       type = init_type (TYPE_CODE_INT,
 239                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 240                         0, "<?type?>", objfile);
 241       warning ("internal error: no Pascal fundamental type %d", typeid);
 242       break;
 243     case FT_VOID:
 244       type = init_type (TYPE_CODE_VOID,
 245                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 246                         0, "void", objfile);
 247       break;
 248     case FT_CHAR:
 249       type = init_type (TYPE_CODE_INT,
 250                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 251                         0, "char", objfile);
 252       break;
 253     case FT_SIGNED_CHAR:
 254       type = init_type (TYPE_CODE_INT,
 255                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 256                         0, "shortint", objfile);
 257       break;
 258     case FT_UNSIGNED_CHAR:
 259       type = init_type (TYPE_CODE_INT,
 260                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 261                         TYPE_FLAG_UNSIGNED, "byte", objfile);
 262       break;
 263     case FT_SHORT:
 264       type = init_type (TYPE_CODE_INT,
 265                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 266                         0, "integer", objfile);
 267       break;
 268     case FT_SIGNED_SHORT:
 269       type = init_type (TYPE_CODE_INT,
 270                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 271                         0, "integer", objfile);         /* FIXME-fnf */
 272       break;
 273     case FT_UNSIGNED_SHORT:
 274       type = init_type (TYPE_CODE_INT,
 275                         TARGET_SHORT_BIT / TARGET_CHAR_BIT,
 276                         TYPE_FLAG_UNSIGNED, "word", objfile);
 277       break;
 278     case FT_INTEGER:
 279       type = init_type (TYPE_CODE_INT,
 280                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 281                         0, "longint", objfile);
 282       break;
 283     case FT_SIGNED_INTEGER:
 284       type = init_type (TYPE_CODE_INT,
 285                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 286                         0, "longint", objfile);         /* FIXME -fnf */
 287       break;
 288     case FT_UNSIGNED_INTEGER:
 289       type = init_type (TYPE_CODE_INT,
 290                         TARGET_INT_BIT / TARGET_CHAR_BIT,
 291                         TYPE_FLAG_UNSIGNED, "cardinal", objfile);
 292       break;
 293     case FT_LONG:
 294       type = init_type (TYPE_CODE_INT,
 295                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 296                         0, "long", objfile);
 297       break;
 298     case FT_SIGNED_LONG:
 299       type = init_type (TYPE_CODE_INT,
 300                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 301                         0, "long", objfile);    /* FIXME -fnf */
 302       break;
 303     case FT_UNSIGNED_LONG:
 304       type = init_type (TYPE_CODE_INT,
 305                         TARGET_LONG_BIT / TARGET_CHAR_BIT,
 306                         TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
 307       break;
 308     case FT_LONG_LONG:
 309       type = init_type (TYPE_CODE_INT,
 310                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 311                         0, "long long", objfile);
 312       break;
 313     case FT_SIGNED_LONG_LONG:
 314       type = init_type (TYPE_CODE_INT,
 315                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 316                         0, "signed long long", objfile);
 317       break;
 318     case FT_UNSIGNED_LONG_LONG:
 319       type = init_type (TYPE_CODE_INT,
 320                         TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
 321                         TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
 322       break;
 323     case FT_FLOAT:
 324       type = init_type (TYPE_CODE_FLT,
 325                         TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
 326                         0, "float", objfile);
 327       break;
 328     case FT_DBL_PREC_FLOAT:
 329       type = init_type (TYPE_CODE_FLT,
 330                         TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 331                         0, "double", objfile);
 332       break;
 333     case FT_EXT_PREC_FLOAT:
 334       type = init_type (TYPE_CODE_FLT,
 335                         TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
 336                         0, "extended", objfile);
 337       break;
 338     }
 339   return (type);
 340 }
 341 \f
 342
 343 /* Table mapping opcodes into strings for printing operators
 344    and precedences of the operators.  */
 345
 346 const struct op_print pascal_op_print_tab[] =
 347 {
 348   {",", BINOP_COMMA, PREC_COMMA, 0},
 349   {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
 350   {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
 351   {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
 352   {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
 353   {"=", BINOP_EQUAL, PREC_EQUAL, 0},
 354   {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
 355   {"<=", BINOP_LEQ, PREC_ORDER, 0},
 356   {">=", BINOP_GEQ, PREC_ORDER, 0},
 357   {">", BINOP_GTR, PREC_ORDER, 0},
 358   {"<", BINOP_LESS, PREC_ORDER, 0},
 359   {"shr", BINOP_RSH, PREC_SHIFT, 0},
 360   {"shl", BINOP_LSH, PREC_SHIFT, 0},
 361   {"+", BINOP_ADD, PREC_ADD, 0},
 362   {"-", BINOP_SUB, PREC_ADD, 0},
 363   {"*", BINOP_MUL, PREC_MUL, 0},
 364   {"/", BINOP_DIV, PREC_MUL, 0},
 365   {"div", BINOP_INTDIV, PREC_MUL, 0},
 366   {"mod", BINOP_REM, PREC_MUL, 0},
 367   {"@", BINOP_REPEAT, PREC_REPEAT, 0},
 368   {"-", UNOP_NEG, PREC_PREFIX, 0},
 369   {"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
 370   {"^", UNOP_IND, PREC_SUFFIX, 1},
 371   {"@", UNOP_ADDR, PREC_PREFIX, 0},
 372   {"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0},
 373   {NULL, 0, 0, 0}
 374 };
 375 \f
 376 struct type **const /* CONST_PTR v 4.17 */ (pascal_builtin_types[]) =
 377 {
 378   &builtin_type_int,
 379     &builtin_type_long,
 380     &builtin_type_short,
 381     &builtin_type_char,
 382     &builtin_type_float,
 383     &builtin_type_double,
 384     &builtin_type_void,
 385     &builtin_type_long_long,
 386     &builtin_type_signed_char,
 387     &builtin_type_unsigned_char,
 388     &builtin_type_unsigned_short,
 389     &builtin_type_unsigned_int,
 390     &builtin_type_unsigned_long,
 391     &builtin_type_unsigned_long_long,
 392     &builtin_type_long_double,
 393     &builtin_type_complex,
 394     &builtin_type_double_complex,
 395     0
 396 };
 397
 398 const struct language_defn pascal_language_defn =
 399 {
 400   "pascal",                     /* Language name */
 401   language_pascal,
 402   pascal_builtin_types,
 403   range_check_on,
 404   type_check_on,
 405   pascal_parse,
 406   pascal_error,
 407   evaluate_subexp_standard,
 408   pascal_printchar,             /* Print a character constant */
 409   pascal_printstr,              /* Function to print string constant */
 410   pascal_emit_char,             /* Print a single char */
 411   pascal_create_fundamental_type,       /* Create fundamental type in this language */
 412   pascal_print_type,            /* Print a type using appropriate syntax */
 413   pascal_val_print,             /* Print a value using appropriate syntax */
 414   pascal_value_print,           /* Print a top-level value */
 415   {"", "%", "b", ""},           /* Binary format info */
 416   {"0%lo", "0", "o", ""},       /* Octal format info */
 417   {"%ld", "", "d", ""},         /* Decimal format info */
 418   {"$%lx", "$", "x", ""},       /* Hex format info */
 419   pascal_op_print_tab,          /* expression operators for printing */
 420   1,                            /* c-style arrays */
 421   0,                            /* String lower bound */
 422   &builtin_type_char,           /* Type of string elements */
 423   LANG_MAGIC
 424 };
 425
 426 void
 427 _initialize_pascal_language ()
 428 {
 429   add_language (&pascal_language_defn);
 430 }