1 /* Pascal language support routines for GDB, the GNU debugger.
2 Copyright 2000, 2002 Free Software Foundation, Inc.
4 This file is part of GDB.
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.
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.
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. */
20 /* This file is derived from c-lang.c */
23 #include "gdb_string.h"
26 #include "expression.h"
27 #include "parser-defs.h"
33 extern void _initialize_pascal_language (void);
36 /* Determines if type TYPE is a pascal string type.
37 Returns 1 if the type is a known pascal type
38 This function is used by p-valprint.c code to allow better string display.
39 If it is a pascal string type, then it also sets info needed
40 to get the length and the data of the string
41 length_pos, length_size and string_pos are given in bytes.
42 char_size gives the element size in bytes.
43 FIXME: if the position or the size of these fields
44 are not multiple of TARGET_CHAR_BIT then the results are wrong
45 but this does not happen for Free Pascal nor for GPC. */
47 is_pascal_string_type (struct type
*type
,int *length_pos
,
48 int *length_size
, int *string_pos
, int *char_size
,
51 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
53 /* Old Borland type pascal strings from Free Pascal Compiler. */
54 /* Two fields: length and st. */
55 if (TYPE_NFIELDS (type
) == 2
56 && strcmp (TYPE_FIELDS (type
)[0].name
, "length") == 0
57 && strcmp (TYPE_FIELDS (type
)[1].name
, "st") == 0)
60 *length_pos
= TYPE_FIELD_BITPOS (type
, 0) / TARGET_CHAR_BIT
;
62 *length_size
= TYPE_LENGTH (TYPE_FIELD_TYPE (type
, 0));
64 *string_pos
= TYPE_FIELD_BITPOS (type
, 1) / TARGET_CHAR_BIT
;
68 *arrayname
= TYPE_FIELDS (type
)[1].name
;
71 /* GNU pascal strings. */
72 /* Three fields: Capacity, length and schema$ or _p_schema. */
73 if (TYPE_NFIELDS (type
) == 3
74 && strcmp (TYPE_FIELDS (type
)[0].name
, "Capacity") == 0
75 && strcmp (TYPE_FIELDS (type
)[1].name
, "length") == 0)
78 *length_pos
= TYPE_FIELD_BITPOS (type
, 1) / TARGET_CHAR_BIT
;
80 *length_size
= TYPE_LENGTH (TYPE_FIELD_TYPE (type
, 1));
82 *string_pos
= TYPE_FIELD_BITPOS (type
, 2) / TARGET_CHAR_BIT
;
83 /* FIXME: how can I detect wide chars in GPC ?? */
87 *arrayname
= TYPE_FIELDS (type
)[2].name
;
94 static void pascal_one_char (int, struct ui_file
*, int *);
96 /* Print the character C on STREAM as part of the contents of a literal
98 In_quotes is reset to 0 if a char is written with #4 notation */
101 pascal_one_char (register int c
, struct ui_file
*stream
, int *in_quotes
)
104 c
&= 0xFF; /* Avoid sign bit follies */
106 if ((c
== '\'') || (PRINT_LITERAL_FORM (c
)))
109 fputs_filtered ("'", stream
);
113 fputs_filtered ("''", stream
);
116 fprintf_filtered (stream
, "%c", c
);
121 fputs_filtered ("'", stream
);
123 fprintf_filtered (stream
, "#%d", (unsigned int) c
);
127 static void pascal_emit_char (int c
, struct ui_file
*stream
, int quoter
);
129 /* Print the character C on STREAM as part of the contents of a literal
130 string whose delimiter is QUOTER. Note that that format for printing
131 characters and strings is language specific. */
134 pascal_emit_char (register int c
, struct ui_file
*stream
, int quoter
)
137 pascal_one_char (c
, stream
, &in_quotes
);
139 fputs_filtered ("'", stream
);
143 pascal_printchar (int c
, struct ui_file
*stream
)
146 pascal_one_char (c
, stream
, &in_quotes
);
148 fputs_filtered ("'", stream
);
151 /* Print the character string STRING, printing at most LENGTH characters.
152 Printing stops early if the number hits print_max; repeat counts
153 are printed as appropriate. Print ellipses at the end if we
154 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
157 pascal_printstr (struct ui_file
*stream
, char *string
, unsigned int length
,
158 int width
, int force_ellipses
)
160 register unsigned int i
;
161 unsigned int things_printed
= 0;
164 extern int inspect_it
;
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
169 if ((!force_ellipses
) && length
> 0 && string
[length
- 1] == '\0')
174 fputs_filtered ("''", stream
);
178 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
180 /* Position of the character we are examining
181 to see whether it is repeated. */
183 /* Number of repetitions we have detected so far. */
190 fputs_filtered (", ", stream
);
196 while (rep1
< length
&& string
[rep1
] == string
[i
])
202 if (reps
> repeat_count_threshold
)
207 fputs_filtered ("\\', ", stream
);
209 fputs_filtered ("', ", stream
);
212 pascal_printchar (string
[i
], stream
);
213 fprintf_filtered (stream
, " <repeats %u times>", reps
);
215 things_printed
+= repeat_count_threshold
;
221 if ((!in_quotes
) && (PRINT_LITERAL_FORM (c
)))
224 fputs_filtered ("\\'", stream
);
226 fputs_filtered ("'", stream
);
229 pascal_one_char (c
, stream
, &in_quotes
);
234 /* Terminate the quotes if necessary. */
238 fputs_filtered ("\\'", stream
);
240 fputs_filtered ("'", stream
);
243 if (force_ellipses
|| i
< length
)
244 fputs_filtered ("...", stream
);
247 /* Create a fundamental Pascal type using default reasonable for the current
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
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 */
270 /* Note there might be some discussion about the choosen correspondance
271 because it mainly reflects Free Pascal Compiler setup for now PM */
275 pascal_create_fundamental_type (struct objfile
*objfile
, int typeid)
277 register struct type
*type
= NULL
;
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);
292 type
= init_type (TYPE_CODE_VOID
,
293 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
297 type
= init_type (TYPE_CODE_CHAR
,
298 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
302 type
= init_type (TYPE_CODE_INT
,
303 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
304 0, "shortint", objfile
);
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
);
312 type
= init_type (TYPE_CODE_INT
,
313 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
314 0, "integer", objfile
);
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 */
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
);
327 type
= init_type (TYPE_CODE_INT
,
328 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
329 0, "longint", objfile
);
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 */
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
);
342 type
= init_type (TYPE_CODE_INT
,
343 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
347 type
= init_type (TYPE_CODE_INT
,
348 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
349 0, "long", objfile
); /* FIXME -fnf */
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
);
357 type
= init_type (TYPE_CODE_INT
,
358 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
359 0, "long long", objfile
);
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
);
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
);
372 type
= init_type (TYPE_CODE_FLT
,
373 TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
374 0, "float", objfile
);
376 case FT_DBL_PREC_FLOAT
:
377 type
= init_type (TYPE_CODE_FLT
,
378 TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
379 0, "double", objfile
);
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
);
391 /* Table mapping opcodes into strings for printing operators
392 and precedences of the operators. */
394 const struct op_print pascal_op_print_tab
[] =
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},
424 struct type
**const (pascal_builtin_types
[]) =
431 &builtin_type_double
,
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
,
446 const struct language_defn pascal_language_defn
=
448 "pascal", /* Language name */
450 pascal_builtin_types
,
456 evaluate_subexp_standard
,
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 {"", "%", "b", ""}, /* Binary format info */
465 {"0%lo", "0", "o", ""}, /* Octal format info */
466 {"%ld", "", "d", ""}, /* Decimal format info */
467 {"$%lx", "$", "x", ""}, /* Hex format info */
468 pascal_op_print_tab
, /* expression operators for printing */
469 1, /* c-style arrays */
470 0, /* String lower bound */
471 &builtin_type_char
, /* Type of string elements */
476 _initialize_pascal_language (void)
478 add_language (&pascal_language_defn
);