1 /* Pascal language support routines for GDB, the GNU debugger.
2 Copyright 2000 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 p-lang.c */
25 #include "expression.h"
26 #include "parser-defs.h"
31 extern void _initialize_pascal_language (void);
32 static void pascal_one_char (int, struct ui_file
*, int *);
34 /* Print the character C on STREAM as part of the contents of a literal
36 In_quotes is reset to 0 if a char is written with #4 notation */
39 pascal_one_char (c
, stream
, in_quotes
)
41 struct ui_file
*stream
;
45 c
&= 0xFF; /* Avoid sign bit follies */
47 if ((c
== '\'') || (PRINT_LITERAL_FORM (c
)))
50 fputs_filtered ("'", stream
);
54 fputs_filtered ("''", stream
);
57 fprintf_filtered (stream
, "%c", c
);
62 fputs_filtered ("'", stream
);
64 fprintf_filtered (stream
, "#%d", (unsigned int) c
);
68 static void pascal_emit_char (int c
, struct ui_file
*stream
, int quoter
);
70 /* Print the character C on STREAM as part of the contents of a literal
71 string whose delimiter is QUOTER. Note that that format for printing
72 characters and strings is language specific. */
75 pascal_emit_char (c
, stream
, quoter
)
77 struct ui_file
*stream
;
81 pascal_one_char (c
, stream
, &in_quotes
);
83 fputs_filtered ("'", stream
);
87 pascal_printchar (c
, stream
)
89 struct ui_file
*stream
;
92 pascal_one_char (c
, stream
, &in_quotes
);
94 fputs_filtered ("'", stream
);
97 /* Print the character string STRING, printing at most LENGTH characters.
98 Printing stops early if the number hits print_max; repeat counts
99 are printed as appropriate. Print ellipses at the end if we
100 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
103 pascal_printstr (stream
, string
, length
, width
, force_ellipses
)
104 struct ui_file
*stream
;
110 register unsigned int i
;
111 unsigned int things_printed
= 0;
114 extern int inspect_it
;
116 /* If the string was not truncated due to `set print elements', and
117 the last byte of it is a null, we don't print that, in traditional C
119 if ((!force_ellipses
) && length
> 0 && string
[length
- 1] == '\0')
124 fputs_filtered ("''", stream
);
128 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
130 /* Position of the character we are examining
131 to see whether it is repeated. */
133 /* Number of repetitions we have detected so far. */
140 fputs_filtered (", ", stream
);
146 while (rep1
< length
&& string
[rep1
] == string
[i
])
152 if (reps
> repeat_count_threshold
)
157 fputs_filtered ("\\', ", stream
);
159 fputs_filtered ("', ", stream
);
162 pascal_printchar (string
[i
], stream
);
163 fprintf_filtered (stream
, " <repeats %u times>", reps
);
165 things_printed
+= repeat_count_threshold
;
171 if ((!in_quotes
) && (PRINT_LITERAL_FORM (c
)))
174 fputs_filtered ("\\'", stream
);
176 fputs_filtered ("'", stream
);
179 pascal_one_char (c
, stream
, &in_quotes
);
184 /* Terminate the quotes if necessary. */
188 fputs_filtered ("\\'", stream
);
190 fputs_filtered ("'", stream
);
193 if (force_ellipses
|| i
< length
)
194 fputs_filtered ("...", stream
);
197 /* Create a fundamental Pascal type using default reasonable for the current
200 Some object/debugging file formats (DWARF version 1, COFF, etc) do not
201 define fundamental types such as "int" or "double". Others (stabs or
202 DWARF version 2, etc) do define fundamental types. For the formats which
203 don't provide fundamental types, gdb can create such types using this
206 FIXME: Some compilers distinguish explicitly signed integral types
207 (signed short, signed int, signed long) from "regular" integral types
208 (short, int, long) in the debugging information. There is some dis-
209 agreement as to how useful this feature is. In particular, gcc does
210 not support this. Also, only some debugging formats allow the
211 distinction to be passed on to a debugger. For now, we always just
212 use "short", "int", or "long" as the type name, for both the implicit
213 and explicitly signed types. This also makes life easier for the
214 gdb test suite since we don't have to account for the differences
215 in output depending upon what the compiler and debugging format
216 support. We will probably have to re-examine the issue when gdb
217 starts taking it's fundamental type information directly from the
218 debugging information supplied by the compiler. fnf@cygnus.com */
220 /* Note there might be some discussion about the choosen correspondance
221 because it mainly reflects Free Pascal Compiler setup for now PM */
225 pascal_create_fundamental_type (objfile
, typeid)
226 struct objfile
*objfile
;
229 register struct type
*type
= NULL
;
234 /* FIXME: For now, if we are asked to produce a type not in this
235 language, create the equivalent of a C integer type with the
236 name "<?type?>". When all the dust settles from the type
237 reconstruction work, this should probably become an error. */
238 type
= init_type (TYPE_CODE_INT
,
239 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
240 0, "<?type?>", objfile
);
241 warning ("internal error: no Pascal fundamental type %d", typeid);
244 type
= init_type (TYPE_CODE_VOID
,
245 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
249 type
= init_type (TYPE_CODE_INT
,
250 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
254 type
= init_type (TYPE_CODE_INT
,
255 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
256 0, "shortint", objfile
);
258 case FT_UNSIGNED_CHAR
:
259 type
= init_type (TYPE_CODE_INT
,
260 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
261 TYPE_FLAG_UNSIGNED
, "byte", objfile
);
264 type
= init_type (TYPE_CODE_INT
,
265 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
266 0, "integer", objfile
);
268 case FT_SIGNED_SHORT
:
269 type
= init_type (TYPE_CODE_INT
,
270 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
271 0, "integer", objfile
); /* FIXME-fnf */
273 case FT_UNSIGNED_SHORT
:
274 type
= init_type (TYPE_CODE_INT
,
275 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
276 TYPE_FLAG_UNSIGNED
, "word", objfile
);
279 type
= init_type (TYPE_CODE_INT
,
280 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
281 0, "longint", objfile
);
283 case FT_SIGNED_INTEGER
:
284 type
= init_type (TYPE_CODE_INT
,
285 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
286 0, "longint", objfile
); /* FIXME -fnf */
288 case FT_UNSIGNED_INTEGER
:
289 type
= init_type (TYPE_CODE_INT
,
290 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
291 TYPE_FLAG_UNSIGNED
, "cardinal", objfile
);
294 type
= init_type (TYPE_CODE_INT
,
295 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
299 type
= init_type (TYPE_CODE_INT
,
300 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
301 0, "long", objfile
); /* FIXME -fnf */
303 case FT_UNSIGNED_LONG
:
304 type
= init_type (TYPE_CODE_INT
,
305 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
306 TYPE_FLAG_UNSIGNED
, "unsigned long", objfile
);
309 type
= init_type (TYPE_CODE_INT
,
310 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
311 0, "long long", objfile
);
313 case FT_SIGNED_LONG_LONG
:
314 type
= init_type (TYPE_CODE_INT
,
315 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
316 0, "signed long long", objfile
);
318 case FT_UNSIGNED_LONG_LONG
:
319 type
= init_type (TYPE_CODE_INT
,
320 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
321 TYPE_FLAG_UNSIGNED
, "unsigned long long", objfile
);
324 type
= init_type (TYPE_CODE_FLT
,
325 TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
326 0, "float", objfile
);
328 case FT_DBL_PREC_FLOAT
:
329 type
= init_type (TYPE_CODE_FLT
,
330 TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
331 0, "double", objfile
);
333 case FT_EXT_PREC_FLOAT
:
334 type
= init_type (TYPE_CODE_FLT
,
335 TARGET_LONG_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
336 0, "extended", objfile
);
343 /* Table mapping opcodes into strings for printing operators
344 and precedences of the operators. */
346 const struct op_print pascal_op_print_tab
[] =
348 {",", BINOP_COMMA
, PREC_COMMA
, 0},
349 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
350 {"or", BINOP_BITWISE_IOR
, PREC_BITWISE_IOR
, 0},
351 {"xor", BINOP_BITWISE_XOR
, PREC_BITWISE_XOR
, 0},
352 {"and", BINOP_BITWISE_AND
, PREC_BITWISE_AND
, 0},
353 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
354 {"<>", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
355 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
356 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
357 {">", BINOP_GTR
, PREC_ORDER
, 0},
358 {"<", BINOP_LESS
, PREC_ORDER
, 0},
359 {"shr", BINOP_RSH
, PREC_SHIFT
, 0},
360 {"shl", BINOP_LSH
, PREC_SHIFT
, 0},
361 {"+", BINOP_ADD
, PREC_ADD
, 0},
362 {"-", BINOP_SUB
, PREC_ADD
, 0},
363 {"*", BINOP_MUL
, PREC_MUL
, 0},
364 {"/", BINOP_DIV
, PREC_MUL
, 0},
365 {"div", BINOP_INTDIV
, PREC_MUL
, 0},
366 {"mod", BINOP_REM
, PREC_MUL
, 0},
367 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
368 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
369 {"not", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
370 {"^", UNOP_IND
, PREC_SUFFIX
, 1},
371 {"@", UNOP_ADDR
, PREC_PREFIX
, 0},
372 {"sizeof", UNOP_SIZEOF
, PREC_PREFIX
, 0},
376 struct type
**const /* CONST_PTR v 4.17 */ (pascal_builtin_types
[]) =
383 &builtin_type_double
,
385 &builtin_type_long_long
,
386 &builtin_type_signed_char
,
387 &builtin_type_unsigned_char
,
388 &builtin_type_unsigned_short
,
389 &builtin_type_unsigned_int
,
390 &builtin_type_unsigned_long
,
391 &builtin_type_unsigned_long_long
,
392 &builtin_type_long_double
,
393 &builtin_type_complex
,
394 &builtin_type_double_complex
,
398 const struct language_defn pascal_language_defn
=
400 "pascal", /* Language name */
402 pascal_builtin_types
,
407 evaluate_subexp_standard
,
408 pascal_printchar
, /* Print a character constant */
409 pascal_printstr
, /* Function to print string constant */
410 pascal_emit_char
, /* Print a single char */
411 pascal_create_fundamental_type
, /* Create fundamental type in this language */
412 pascal_print_type
, /* Print a type using appropriate syntax */
413 pascal_val_print
, /* Print a value using appropriate syntax */
414 pascal_value_print
, /* Print a top-level value */
415 {"", "%", "b", ""}, /* Binary format info */
416 {"0%lo", "0", "o", ""}, /* Octal format info */
417 {"%ld", "", "d", ""}, /* Decimal format info */
418 {"$%lx", "$", "x", ""}, /* Hex format info */
419 pascal_op_print_tab
, /* expression operators for printing */
420 1, /* c-style arrays */
421 0, /* String lower bound */
422 &builtin_type_char
, /* Type of string elements */
427 _initialize_pascal_language ()
429 add_language (&pascal_language_defn
);