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