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