1 /* Pascal language support routines for GDB, the GNU debugger.
3 Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007
4 Free Software Foundation, Inc.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 /* This file is derived from c-lang.c */
26 #include "gdb_string.h"
29 #include "expression.h"
30 #include "parser-defs.h"
37 extern void _initialize_pascal_language (void);
40 /* Determines if type TYPE is a pascal string type.
41 Returns 1 if the type is a known pascal type
42 This function is used by p-valprint.c code to allow better string display.
43 If it is a pascal string type, then it also sets info needed
44 to get the length and the data of the string
45 length_pos, length_size and string_pos are given in bytes.
46 char_size gives the element size in bytes.
47 FIXME: if the position or the size of these fields
48 are not multiple of TARGET_CHAR_BIT then the results are wrong
49 but this does not happen for Free Pascal nor for GPC. */
51 is_pascal_string_type (struct type
*type
,int *length_pos
,
52 int *length_size
, int *string_pos
, int *char_size
,
55 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
57 /* Old Borland type pascal strings from Free Pascal Compiler. */
58 /* Two fields: length and st. */
59 if (TYPE_NFIELDS (type
) == 2
60 && strcmp (TYPE_FIELDS (type
)[0].name
, "length") == 0
61 && strcmp (TYPE_FIELDS (type
)[1].name
, "st") == 0)
64 *length_pos
= TYPE_FIELD_BITPOS (type
, 0) / TARGET_CHAR_BIT
;
66 *length_size
= TYPE_LENGTH (TYPE_FIELD_TYPE (type
, 0));
68 *string_pos
= TYPE_FIELD_BITPOS (type
, 1) / TARGET_CHAR_BIT
;
72 *arrayname
= TYPE_FIELDS (type
)[1].name
;
75 /* GNU pascal strings. */
76 /* Three fields: Capacity, length and schema$ or _p_schema. */
77 if (TYPE_NFIELDS (type
) == 3
78 && strcmp (TYPE_FIELDS (type
)[0].name
, "Capacity") == 0
79 && strcmp (TYPE_FIELDS (type
)[1].name
, "length") == 0)
82 *length_pos
= TYPE_FIELD_BITPOS (type
, 1) / TARGET_CHAR_BIT
;
84 *length_size
= TYPE_LENGTH (TYPE_FIELD_TYPE (type
, 1));
86 *string_pos
= TYPE_FIELD_BITPOS (type
, 2) / TARGET_CHAR_BIT
;
87 /* FIXME: how can I detect wide chars in GPC ?? */
91 *arrayname
= TYPE_FIELDS (type
)[2].name
;
98 static void pascal_one_char (int, struct ui_file
*, int *);
100 /* Print the character C on STREAM as part of the contents of a literal
102 In_quotes is reset to 0 if a char is written with #4 notation */
105 pascal_one_char (int c
, struct ui_file
*stream
, int *in_quotes
)
108 c
&= 0xFF; /* Avoid sign bit follies */
110 if ((c
== '\'') || (PRINT_LITERAL_FORM (c
)))
113 fputs_filtered ("'", stream
);
117 fputs_filtered ("''", stream
);
120 fprintf_filtered (stream
, "%c", c
);
125 fputs_filtered ("'", stream
);
127 fprintf_filtered (stream
, "#%d", (unsigned int) c
);
131 static void pascal_emit_char (int c
, struct ui_file
*stream
, int quoter
);
133 /* Print the character C on STREAM as part of the contents of a literal
134 string whose delimiter is QUOTER. Note that that format for printing
135 characters and strings is language specific. */
138 pascal_emit_char (int c
, struct ui_file
*stream
, int quoter
)
141 pascal_one_char (c
, stream
, &in_quotes
);
143 fputs_filtered ("'", stream
);
147 pascal_printchar (int c
, struct ui_file
*stream
)
150 pascal_one_char (c
, stream
, &in_quotes
);
152 fputs_filtered ("'", stream
);
155 /* Print the character string STRING, printing at most LENGTH characters.
156 Printing stops early if the number hits print_max; repeat counts
157 are printed as appropriate. Print ellipses at the end if we
158 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
161 pascal_printstr (struct ui_file
*stream
, const gdb_byte
*string
,
162 unsigned int length
, int width
, int force_ellipses
)
165 unsigned int things_printed
= 0;
169 /* If the string was not truncated due to `set print elements', and
170 the last byte of it is a null, we don't print that, in traditional C
172 if ((!force_ellipses
) && length
> 0 && string
[length
- 1] == '\0')
177 fputs_filtered ("''", stream
);
181 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
183 /* Position of the character we are examining
184 to see whether it is repeated. */
186 /* Number of repetitions we have detected so far. */
193 fputs_filtered (", ", stream
);
199 while (rep1
< length
&& string
[rep1
] == string
[i
])
205 if (reps
> repeat_count_threshold
)
210 fputs_filtered ("\\', ", stream
);
212 fputs_filtered ("', ", stream
);
215 pascal_printchar (string
[i
], stream
);
216 fprintf_filtered (stream
, " <repeats %u times>", reps
);
218 things_printed
+= repeat_count_threshold
;
224 if ((!in_quotes
) && (PRINT_LITERAL_FORM (c
)))
227 fputs_filtered ("\\'", stream
);
229 fputs_filtered ("'", stream
);
232 pascal_one_char (c
, stream
, &in_quotes
);
237 /* Terminate the quotes if necessary. */
241 fputs_filtered ("\\'", stream
);
243 fputs_filtered ("'", stream
);
246 if (force_ellipses
|| i
< length
)
247 fputs_filtered ("...", stream
);
250 /* Create a fundamental Pascal type using default reasonable for the current
253 Some object/debugging file formats (DWARF version 1, COFF, etc) do not
254 define fundamental types such as "int" or "double". Others (stabs or
255 DWARF version 2, etc) do define fundamental types. For the formats which
256 don't provide fundamental types, gdb can create such types using this
259 FIXME: Some compilers distinguish explicitly signed integral types
260 (signed short, signed int, signed long) from "regular" integral types
261 (short, int, long) in the debugging information. There is some dis-
262 agreement as to how useful this feature is. In particular, gcc does
263 not support this. Also, only some debugging formats allow the
264 distinction to be passed on to a debugger. For now, we always just
265 use "short", "int", or "long" as the type name, for both the implicit
266 and explicitly signed types. This also makes life easier for the
267 gdb test suite since we don't have to account for the differences
268 in output depending upon what the compiler and debugging format
269 support. We will probably have to re-examine the issue when gdb
270 starts taking it's fundamental type information directly from the
271 debugging information supplied by the compiler. fnf@cygnus.com */
273 /* Note there might be some discussion about the choosen correspondance
274 because it mainly reflects Free Pascal Compiler setup for now PM */
278 pascal_create_fundamental_type (struct objfile
*objfile
, int typeid)
280 struct type
*type
= NULL
;
285 /* FIXME: For now, if we are asked to produce a type not in this
286 language, create the equivalent of a C integer type with the
287 name "<?type?>". When all the dust settles from the type
288 reconstruction work, this should probably become an error. */
289 type
= init_type (TYPE_CODE_INT
,
290 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
291 0, "<?type?>", objfile
);
292 warning (_("internal error: no Pascal fundamental type %d"), typeid);
295 type
= init_type (TYPE_CODE_VOID
,
296 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
300 type
= init_type (TYPE_CODE_CHAR
,
301 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
305 type
= init_type (TYPE_CODE_INT
,
306 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
307 0, "shortint", objfile
);
309 case FT_UNSIGNED_CHAR
:
310 type
= init_type (TYPE_CODE_INT
,
311 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
312 TYPE_FLAG_UNSIGNED
, "byte", objfile
);
315 type
= init_type (TYPE_CODE_INT
,
316 gdbarch_short_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
317 0, "integer", objfile
);
319 case FT_SIGNED_SHORT
:
320 type
= init_type (TYPE_CODE_INT
,
321 gdbarch_short_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
322 0, "integer", objfile
); /* FIXME-fnf */
324 case FT_UNSIGNED_SHORT
:
325 type
= init_type (TYPE_CODE_INT
,
326 gdbarch_short_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
327 TYPE_FLAG_UNSIGNED
, "word", objfile
);
330 type
= init_type (TYPE_CODE_INT
,
331 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
332 0, "longint", objfile
);
334 case FT_SIGNED_INTEGER
:
335 type
= init_type (TYPE_CODE_INT
,
336 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
337 0, "longint", objfile
); /* FIXME -fnf */
339 case FT_UNSIGNED_INTEGER
:
340 type
= init_type (TYPE_CODE_INT
,
341 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
342 TYPE_FLAG_UNSIGNED
, "cardinal", objfile
);
345 type
= init_type (TYPE_CODE_INT
,
346 gdbarch_long_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
350 type
= init_type (TYPE_CODE_INT
,
351 gdbarch_long_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
352 0, "long", objfile
); /* FIXME -fnf */
354 case FT_UNSIGNED_LONG
:
355 type
= init_type (TYPE_CODE_INT
,
356 gdbarch_long_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
357 TYPE_FLAG_UNSIGNED
, "unsigned long", objfile
);
360 type
= init_type (TYPE_CODE_INT
,
361 gdbarch_long_long_bit
362 (current_gdbarch
) / TARGET_CHAR_BIT
,
363 0, "long long", objfile
);
365 case FT_SIGNED_LONG_LONG
:
366 type
= init_type (TYPE_CODE_INT
,
367 gdbarch_long_long_bit
368 (current_gdbarch
) / TARGET_CHAR_BIT
,
369 0, "signed long long", objfile
);
371 case FT_UNSIGNED_LONG_LONG
:
372 type
= init_type (TYPE_CODE_INT
,
373 gdbarch_long_long_bit
374 (current_gdbarch
) / TARGET_CHAR_BIT
,
375 TYPE_FLAG_UNSIGNED
, "unsigned long long", objfile
);
378 type
= init_type (TYPE_CODE_FLT
,
379 gdbarch_float_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
380 0, "float", objfile
);
382 case FT_DBL_PREC_FLOAT
:
383 type
= init_type (TYPE_CODE_FLT
,
384 gdbarch_double_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
385 0, "double", objfile
);
387 case FT_EXT_PREC_FLOAT
:
388 type
= init_type (TYPE_CODE_FLT
,
389 gdbarch_long_double_bit (current_gdbarch
)
391 0, "extended", objfile
);
398 /* Table mapping opcodes into strings for printing operators
399 and precedences of the operators. */
401 const struct op_print pascal_op_print_tab
[] =
403 {",", BINOP_COMMA
, PREC_COMMA
, 0},
404 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
405 {"or", BINOP_BITWISE_IOR
, PREC_BITWISE_IOR
, 0},
406 {"xor", BINOP_BITWISE_XOR
, PREC_BITWISE_XOR
, 0},
407 {"and", BINOP_BITWISE_AND
, PREC_BITWISE_AND
, 0},
408 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
409 {"<>", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
410 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
411 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
412 {">", BINOP_GTR
, PREC_ORDER
, 0},
413 {"<", BINOP_LESS
, PREC_ORDER
, 0},
414 {"shr", BINOP_RSH
, PREC_SHIFT
, 0},
415 {"shl", BINOP_LSH
, PREC_SHIFT
, 0},
416 {"+", BINOP_ADD
, PREC_ADD
, 0},
417 {"-", BINOP_SUB
, PREC_ADD
, 0},
418 {"*", BINOP_MUL
, PREC_MUL
, 0},
419 {"/", BINOP_DIV
, PREC_MUL
, 0},
420 {"div", BINOP_INTDIV
, PREC_MUL
, 0},
421 {"mod", BINOP_REM
, PREC_MUL
, 0},
422 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
423 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
424 {"not", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
425 {"^", UNOP_IND
, PREC_SUFFIX
, 1},
426 {"@", UNOP_ADDR
, PREC_PREFIX
, 0},
427 {"sizeof", UNOP_SIZEOF
, PREC_PREFIX
, 0},
431 struct type
**const (pascal_builtin_types
[]) =
438 &builtin_type_double
,
440 &builtin_type_long_long
,
441 &builtin_type_signed_char
,
442 &builtin_type_unsigned_char
,
443 &builtin_type_unsigned_short
,
444 &builtin_type_unsigned_int
,
445 &builtin_type_unsigned_long
,
446 &builtin_type_unsigned_long_long
,
447 &builtin_type_long_double
,
448 &builtin_type_complex
,
449 &builtin_type_double_complex
,
453 const struct language_defn pascal_language_defn
=
455 "pascal", /* Language name */
457 pascal_builtin_types
,
462 &exp_descriptor_standard
,
466 pascal_printchar
, /* Print a character constant */
467 pascal_printstr
, /* Function to print string constant */
468 pascal_emit_char
, /* Print a single char */
469 pascal_create_fundamental_type
, /* Create fundamental type in this language */
470 pascal_print_type
, /* Print a type using appropriate syntax */
471 pascal_val_print
, /* Print a value using appropriate syntax */
472 pascal_value_print
, /* Print a top-level value */
473 NULL
, /* Language specific skip_trampoline */
474 value_of_this
, /* value_of_this */
475 basic_lookup_symbol_nonlocal
, /* lookup_symbol_nonlocal */
476 basic_lookup_transparent_type
,/* lookup_transparent_type */
477 NULL
, /* Language specific symbol demangler */
478 NULL
, /* Language specific class_name_from_physname */
479 pascal_op_print_tab
, /* expression operators for printing */
480 1, /* c-style arrays */
481 0, /* String lower bound */
482 &builtin_type_char
, /* Type of string elements */
483 default_word_break_characters
,
484 NULL
, /* FIXME: la_language_arch_info. */
485 default_print_array_index
,
490 _initialize_pascal_language (void)
492 add_language (&pascal_language_defn
);