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 */
25 #include "expression.h"
26 #include "parser-defs.h"
32 extern void _initialize_pascal_language (void);
35 /* Determines if type TYPE is a pascal string type.
36 Returns 1 if the type is a known pascal type
37 This function is used by p-valprint.c code to allow better string display.
38 If it is a pascal string type, then it also sets info needed
39 to get the length and the data of the string
40 length_pos, length_size and string_pos are given in bytes.
41 char_size gives the element size in bytes.
42 FIXME: if the position or the size of these fields
43 are not multiple of TARGET_CHAR_BIT then the results are wrong
44 but this does not happen for Free Pascal nor for GPC. */
46 is_pascal_string_type (struct type
*type
,int *length_pos
,
47 int * length_size
, int *string_pos
, int *char_size
)
49 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
51 /* Old Borland type pascal strings from Free Pascal Compiler. */
52 /* Two fields: length and st. */
53 if (TYPE_NFIELDS (type
) == 2
54 && strcmp (TYPE_FIELDS (type
)[0].name
, "length") == 0
55 && strcmp (TYPE_FIELDS (type
)[1].name
, "st") == 0)
57 *length_pos
= TYPE_FIELD_BITPOS (type
, 0) / TARGET_CHAR_BIT
;
58 *length_size
= TYPE_FIELD_TYPE (type
, 0)->length
;
59 *string_pos
= TYPE_FIELD_BITPOS (type
, 1) / TARGET_CHAR_BIT
;
63 /* GNU pascal strings. */
64 /* Three fields: Capacity, length and schema$ or _p_schema. */
65 if (TYPE_NFIELDS (type
) == 3
66 && strcmp (TYPE_FIELDS (type
)[0].name
, "Capacity") == 0
67 && strcmp (TYPE_FIELDS (type
)[1].name
, "length") == 0)
69 *length_pos
= TYPE_FIELD_BITPOS (type
, 1) / TARGET_CHAR_BIT
;
70 *length_size
= TYPE_FIELD_TYPE (type
, 1)->length
;
71 *string_pos
= TYPE_FIELD_BITPOS (type
, 2) / TARGET_CHAR_BIT
;
72 /* FIXME: how can I detect wide chars in GPC ?? */
80 static void pascal_one_char (int, struct ui_file
*, int *);
82 /* Print the character C on STREAM as part of the contents of a literal
84 In_quotes is reset to 0 if a char is written with #4 notation */
87 pascal_one_char (register int c
, struct ui_file
*stream
, int *in_quotes
)
90 c
&= 0xFF; /* Avoid sign bit follies */
92 if ((c
== '\'') || (PRINT_LITERAL_FORM (c
)))
95 fputs_filtered ("'", stream
);
99 fputs_filtered ("''", stream
);
102 fprintf_filtered (stream
, "%c", c
);
107 fputs_filtered ("'", stream
);
109 fprintf_filtered (stream
, "#%d", (unsigned int) c
);
113 static void pascal_emit_char (int c
, struct ui_file
*stream
, int quoter
);
115 /* Print the character C on STREAM as part of the contents of a literal
116 string whose delimiter is QUOTER. Note that that format for printing
117 characters and strings is language specific. */
120 pascal_emit_char (register int c
, struct ui_file
*stream
, int quoter
)
123 pascal_one_char (c
, stream
, &in_quotes
);
125 fputs_filtered ("'", stream
);
129 pascal_printchar (int c
, struct ui_file
*stream
)
132 pascal_one_char (c
, stream
, &in_quotes
);
134 fputs_filtered ("'", stream
);
137 /* Print the character string STRING, printing at most LENGTH characters.
138 Printing stops early if the number hits print_max; repeat counts
139 are printed as appropriate. Print ellipses at the end if we
140 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
143 pascal_printstr (struct ui_file
*stream
, char *string
, unsigned int length
,
144 int width
, int force_ellipses
)
146 register unsigned int i
;
147 unsigned int things_printed
= 0;
150 extern int inspect_it
;
152 /* If the string was not truncated due to `set print elements', and
153 the last byte of it is a null, we don't print that, in traditional C
155 if ((!force_ellipses
) && length
> 0 && string
[length
- 1] == '\0')
160 fputs_filtered ("''", stream
);
164 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
166 /* Position of the character we are examining
167 to see whether it is repeated. */
169 /* Number of repetitions we have detected so far. */
176 fputs_filtered (", ", stream
);
182 while (rep1
< length
&& string
[rep1
] == string
[i
])
188 if (reps
> repeat_count_threshold
)
193 fputs_filtered ("\\', ", stream
);
195 fputs_filtered ("', ", stream
);
198 pascal_printchar (string
[i
], stream
);
199 fprintf_filtered (stream
, " <repeats %u times>", reps
);
201 things_printed
+= repeat_count_threshold
;
207 if ((!in_quotes
) && (PRINT_LITERAL_FORM (c
)))
210 fputs_filtered ("\\'", stream
);
212 fputs_filtered ("'", stream
);
215 pascal_one_char (c
, stream
, &in_quotes
);
220 /* Terminate the quotes if necessary. */
224 fputs_filtered ("\\'", stream
);
226 fputs_filtered ("'", stream
);
229 if (force_ellipses
|| i
< length
)
230 fputs_filtered ("...", stream
);
233 /* Create a fundamental Pascal type using default reasonable for the current
236 Some object/debugging file formats (DWARF version 1, COFF, etc) do not
237 define fundamental types such as "int" or "double". Others (stabs or
238 DWARF version 2, etc) do define fundamental types. For the formats which
239 don't provide fundamental types, gdb can create such types using this
242 FIXME: Some compilers distinguish explicitly signed integral types
243 (signed short, signed int, signed long) from "regular" integral types
244 (short, int, long) in the debugging information. There is some dis-
245 agreement as to how useful this feature is. In particular, gcc does
246 not support this. Also, only some debugging formats allow the
247 distinction to be passed on to a debugger. For now, we always just
248 use "short", "int", or "long" as the type name, for both the implicit
249 and explicitly signed types. This also makes life easier for the
250 gdb test suite since we don't have to account for the differences
251 in output depending upon what the compiler and debugging format
252 support. We will probably have to re-examine the issue when gdb
253 starts taking it's fundamental type information directly from the
254 debugging information supplied by the compiler. fnf@cygnus.com */
256 /* Note there might be some discussion about the choosen correspondance
257 because it mainly reflects Free Pascal Compiler setup for now PM */
261 pascal_create_fundamental_type (struct objfile
*objfile
, int typeid)
263 register struct type
*type
= NULL
;
268 /* FIXME: For now, if we are asked to produce a type not in this
269 language, create the equivalent of a C integer type with the
270 name "<?type?>". When all the dust settles from the type
271 reconstruction work, this should probably become an error. */
272 type
= init_type (TYPE_CODE_INT
,
273 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
274 0, "<?type?>", objfile
);
275 warning ("internal error: no Pascal fundamental type %d", typeid);
278 type
= init_type (TYPE_CODE_VOID
,
279 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
283 type
= init_type (TYPE_CODE_INT
,
284 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
288 type
= init_type (TYPE_CODE_INT
,
289 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
290 0, "shortint", objfile
);
292 case FT_UNSIGNED_CHAR
:
293 type
= init_type (TYPE_CODE_INT
,
294 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
295 TYPE_FLAG_UNSIGNED
, "byte", objfile
);
298 type
= init_type (TYPE_CODE_INT
,
299 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
300 0, "integer", objfile
);
302 case FT_SIGNED_SHORT
:
303 type
= init_type (TYPE_CODE_INT
,
304 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
305 0, "integer", objfile
); /* FIXME-fnf */
307 case FT_UNSIGNED_SHORT
:
308 type
= init_type (TYPE_CODE_INT
,
309 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
310 TYPE_FLAG_UNSIGNED
, "word", objfile
);
313 type
= init_type (TYPE_CODE_INT
,
314 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
315 0, "longint", objfile
);
317 case FT_SIGNED_INTEGER
:
318 type
= init_type (TYPE_CODE_INT
,
319 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
320 0, "longint", objfile
); /* FIXME -fnf */
322 case FT_UNSIGNED_INTEGER
:
323 type
= init_type (TYPE_CODE_INT
,
324 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
325 TYPE_FLAG_UNSIGNED
, "cardinal", objfile
);
328 type
= init_type (TYPE_CODE_INT
,
329 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
333 type
= init_type (TYPE_CODE_INT
,
334 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
335 0, "long", objfile
); /* FIXME -fnf */
337 case FT_UNSIGNED_LONG
:
338 type
= init_type (TYPE_CODE_INT
,
339 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
340 TYPE_FLAG_UNSIGNED
, "unsigned long", objfile
);
343 type
= init_type (TYPE_CODE_INT
,
344 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
345 0, "long long", objfile
);
347 case FT_SIGNED_LONG_LONG
:
348 type
= init_type (TYPE_CODE_INT
,
349 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
350 0, "signed long long", objfile
);
352 case FT_UNSIGNED_LONG_LONG
:
353 type
= init_type (TYPE_CODE_INT
,
354 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
355 TYPE_FLAG_UNSIGNED
, "unsigned long long", objfile
);
358 type
= init_type (TYPE_CODE_FLT
,
359 TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
360 0, "float", objfile
);
362 case FT_DBL_PREC_FLOAT
:
363 type
= init_type (TYPE_CODE_FLT
,
364 TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
365 0, "double", objfile
);
367 case FT_EXT_PREC_FLOAT
:
368 type
= init_type (TYPE_CODE_FLT
,
369 TARGET_LONG_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
370 0, "extended", objfile
);
377 /* Table mapping opcodes into strings for printing operators
378 and precedences of the operators. */
380 const struct op_print pascal_op_print_tab
[] =
382 {",", BINOP_COMMA
, PREC_COMMA
, 0},
383 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
384 {"or", BINOP_BITWISE_IOR
, PREC_BITWISE_IOR
, 0},
385 {"xor", BINOP_BITWISE_XOR
, PREC_BITWISE_XOR
, 0},
386 {"and", BINOP_BITWISE_AND
, PREC_BITWISE_AND
, 0},
387 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
388 {"<>", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
389 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
390 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
391 {">", BINOP_GTR
, PREC_ORDER
, 0},
392 {"<", BINOP_LESS
, PREC_ORDER
, 0},
393 {"shr", BINOP_RSH
, PREC_SHIFT
, 0},
394 {"shl", BINOP_LSH
, PREC_SHIFT
, 0},
395 {"+", BINOP_ADD
, PREC_ADD
, 0},
396 {"-", BINOP_SUB
, PREC_ADD
, 0},
397 {"*", BINOP_MUL
, PREC_MUL
, 0},
398 {"/", BINOP_DIV
, PREC_MUL
, 0},
399 {"div", BINOP_INTDIV
, PREC_MUL
, 0},
400 {"mod", BINOP_REM
, PREC_MUL
, 0},
401 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
402 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
403 {"not", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
404 {"^", UNOP_IND
, PREC_SUFFIX
, 1},
405 {"@", UNOP_ADDR
, PREC_PREFIX
, 0},
406 {"sizeof", UNOP_SIZEOF
, PREC_PREFIX
, 0},
410 struct type
**const (pascal_builtin_types
[]) =
417 &builtin_type_double
,
419 &builtin_type_long_long
,
420 &builtin_type_signed_char
,
421 &builtin_type_unsigned_char
,
422 &builtin_type_unsigned_short
,
423 &builtin_type_unsigned_int
,
424 &builtin_type_unsigned_long
,
425 &builtin_type_unsigned_long_long
,
426 &builtin_type_long_double
,
427 &builtin_type_complex
,
428 &builtin_type_double_complex
,
432 const struct language_defn pascal_language_defn
=
434 "pascal", /* Language name */
436 pascal_builtin_types
,
442 evaluate_subexp_standard
,
443 pascal_printchar
, /* Print a character constant */
444 pascal_printstr
, /* Function to print string constant */
445 pascal_emit_char
, /* Print a single char */
446 pascal_create_fundamental_type
, /* Create fundamental type in this language */
447 pascal_print_type
, /* Print a type using appropriate syntax */
448 pascal_val_print
, /* Print a value using appropriate syntax */
449 pascal_value_print
, /* Print a top-level value */
450 {"", "%", "b", ""}, /* Binary format info */
451 {"0%lo", "0", "o", ""}, /* Octal format info */
452 {"%ld", "", "d", ""}, /* Decimal format info */
453 {"$%lx", "$", "x", ""}, /* Hex format info */
454 pascal_op_print_tab
, /* expression operators for printing */
455 1, /* c-style arrays */
456 0, /* String lower bound */
457 &builtin_type_char
, /* Type of string elements */
462 _initialize_pascal_language (void)
464 add_language (&pascal_language_defn
);