]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blob - gdb/p-lang.c
* breakpoint.c:
[thirdparty/binutils-gdb.git] / gdb / p-lang.c
1 /* Pascal language support routines for GDB, the GNU debugger.
2
3 Copyright (C) 2000, 2002, 2003, 2004, 2005 Free Software Foundation,
4 Inc.
5
6 This file is part of GDB.
7
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.
12
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.
17
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. */
22
23 /* This file is derived from c-lang.c */
24
25 #include "defs.h"
26 #include "gdb_string.h"
27 #include "symtab.h"
28 #include "gdbtypes.h"
29 #include "expression.h"
30 #include "parser-defs.h"
31 #include "language.h"
32 #include "p-lang.h"
33 #include "valprint.h"
34 #include "value.h"
35 #include <ctype.h>
36
37 extern void _initialize_pascal_language (void);
38
39
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. */
50 int
51 is_pascal_string_type (struct type *type,int *length_pos,
52 int *length_size, int *string_pos, int *char_size,
53 char **arrayname)
54 {
55 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
56 {
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)
62 {
63 if (length_pos)
64 *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT;
65 if (length_size)
66 *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
67 if (string_pos)
68 *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
69 if (char_size)
70 *char_size = 1;
71 if (arrayname)
72 *arrayname = TYPE_FIELDS (type)[1].name;
73 return 2;
74 };
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)
80 {
81 if (length_pos)
82 *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
83 if (length_size)
84 *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 1));
85 if (string_pos)
86 *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT;
87 /* FIXME: how can I detect wide chars in GPC ?? */
88 if (char_size)
89 *char_size = 1;
90 if (arrayname)
91 *arrayname = TYPE_FIELDS (type)[2].name;
92 return 3;
93 };
94 }
95 return 0;
96 }
97
98 static void pascal_one_char (int, struct ui_file *, int *);
99
100 /* Print the character C on STREAM as part of the contents of a literal
101 string.
102 In_quotes is reset to 0 if a char is written with #4 notation */
103
104 static void
105 pascal_one_char (int c, struct ui_file *stream, int *in_quotes)
106 {
107
108 c &= 0xFF; /* Avoid sign bit follies */
109
110 if ((c == '\'') || (PRINT_LITERAL_FORM (c)))
111 {
112 if (!(*in_quotes))
113 fputs_filtered ("'", stream);
114 *in_quotes = 1;
115 if (c == '\'')
116 {
117 fputs_filtered ("''", stream);
118 }
119 else
120 fprintf_filtered (stream, "%c", c);
121 }
122 else
123 {
124 if (*in_quotes)
125 fputs_filtered ("'", stream);
126 *in_quotes = 0;
127 fprintf_filtered (stream, "#%d", (unsigned int) c);
128 }
129 }
130
131 static void pascal_emit_char (int c, struct ui_file *stream, int quoter);
132
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. */
136
137 static void
138 pascal_emit_char (int c, struct ui_file *stream, int quoter)
139 {
140 int in_quotes = 0;
141 pascal_one_char (c, stream, &in_quotes);
142 if (in_quotes)
143 fputs_filtered ("'", stream);
144 }
145
146 void
147 pascal_printchar (int c, struct ui_file *stream)
148 {
149 int in_quotes = 0;
150 pascal_one_char (c, stream, &in_quotes);
151 if (in_quotes)
152 fputs_filtered ("'", stream);
153 }
154
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. */
159
160 void
161 pascal_printstr (struct ui_file *stream, const gdb_byte *string,
162 unsigned int length, int width, int force_ellipses)
163 {
164 unsigned int i;
165 unsigned int things_printed = 0;
166 int in_quotes = 0;
167 int need_comma = 0;
168
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
171 style. */
172 if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
173 length--;
174
175 if (length == 0)
176 {
177 fputs_filtered ("''", stream);
178 return;
179 }
180
181 for (i = 0; i < length && things_printed < print_max; ++i)
182 {
183 /* Position of the character we are examining
184 to see whether it is repeated. */
185 unsigned int rep1;
186 /* Number of repetitions we have detected so far. */
187 unsigned int reps;
188
189 QUIT;
190
191 if (need_comma)
192 {
193 fputs_filtered (", ", stream);
194 need_comma = 0;
195 }
196
197 rep1 = i + 1;
198 reps = 1;
199 while (rep1 < length && string[rep1] == string[i])
200 {
201 ++rep1;
202 ++reps;
203 }
204
205 if (reps > repeat_count_threshold)
206 {
207 if (in_quotes)
208 {
209 if (inspect_it)
210 fputs_filtered ("\\', ", stream);
211 else
212 fputs_filtered ("', ", stream);
213 in_quotes = 0;
214 }
215 pascal_printchar (string[i], stream);
216 fprintf_filtered (stream, " <repeats %u times>", reps);
217 i = rep1 - 1;
218 things_printed += repeat_count_threshold;
219 need_comma = 1;
220 }
221 else
222 {
223 int c = string[i];
224 if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
225 {
226 if (inspect_it)
227 fputs_filtered ("\\'", stream);
228 else
229 fputs_filtered ("'", stream);
230 in_quotes = 1;
231 }
232 pascal_one_char (c, stream, &in_quotes);
233 ++things_printed;
234 }
235 }
236
237 /* Terminate the quotes if necessary. */
238 if (in_quotes)
239 {
240 if (inspect_it)
241 fputs_filtered ("\\'", stream);
242 else
243 fputs_filtered ("'", stream);
244 }
245
246 if (force_ellipses || i < length)
247 fputs_filtered ("...", stream);
248 }
249
250 /* Create a fundamental Pascal type using default reasonable for the current
251 target machine.
252
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
257 function.
258
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 */
272
273 /* Note there might be some discussion about the choosen correspondance
274 because it mainly reflects Free Pascal Compiler setup for now PM */
275
276
277 struct type *
278 pascal_create_fundamental_type (struct objfile *objfile, int typeid)
279 {
280 struct type *type = NULL;
281
282 switch (typeid)
283 {
284 default:
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 TARGET_INT_BIT / TARGET_CHAR_BIT,
291 0, "<?type?>", objfile);
292 warning (_("internal error: no Pascal fundamental type %d"), typeid);
293 break;
294 case FT_VOID:
295 type = init_type (TYPE_CODE_VOID,
296 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
297 0, "void", objfile);
298 break;
299 case FT_CHAR:
300 type = init_type (TYPE_CODE_CHAR,
301 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
302 0, "char", objfile);
303 break;
304 case FT_SIGNED_CHAR:
305 type = init_type (TYPE_CODE_INT,
306 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
307 0, "shortint", objfile);
308 break;
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);
313 break;
314 case FT_SHORT:
315 type = init_type (TYPE_CODE_INT,
316 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
317 0, "integer", objfile);
318 break;
319 case FT_SIGNED_SHORT:
320 type = init_type (TYPE_CODE_INT,
321 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
322 0, "integer", objfile); /* FIXME-fnf */
323 break;
324 case FT_UNSIGNED_SHORT:
325 type = init_type (TYPE_CODE_INT,
326 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
327 TYPE_FLAG_UNSIGNED, "word", objfile);
328 break;
329 case FT_INTEGER:
330 type = init_type (TYPE_CODE_INT,
331 TARGET_INT_BIT / TARGET_CHAR_BIT,
332 0, "longint", objfile);
333 break;
334 case FT_SIGNED_INTEGER:
335 type = init_type (TYPE_CODE_INT,
336 TARGET_INT_BIT / TARGET_CHAR_BIT,
337 0, "longint", objfile); /* FIXME -fnf */
338 break;
339 case FT_UNSIGNED_INTEGER:
340 type = init_type (TYPE_CODE_INT,
341 TARGET_INT_BIT / TARGET_CHAR_BIT,
342 TYPE_FLAG_UNSIGNED, "cardinal", objfile);
343 break;
344 case FT_LONG:
345 type = init_type (TYPE_CODE_INT,
346 TARGET_LONG_BIT / TARGET_CHAR_BIT,
347 0, "long", objfile);
348 break;
349 case FT_SIGNED_LONG:
350 type = init_type (TYPE_CODE_INT,
351 TARGET_LONG_BIT / TARGET_CHAR_BIT,
352 0, "long", objfile); /* FIXME -fnf */
353 break;
354 case FT_UNSIGNED_LONG:
355 type = init_type (TYPE_CODE_INT,
356 TARGET_LONG_BIT / TARGET_CHAR_BIT,
357 TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
358 break;
359 case FT_LONG_LONG:
360 type = init_type (TYPE_CODE_INT,
361 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
362 0, "long long", objfile);
363 break;
364 case FT_SIGNED_LONG_LONG:
365 type = init_type (TYPE_CODE_INT,
366 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
367 0, "signed long long", objfile);
368 break;
369 case FT_UNSIGNED_LONG_LONG:
370 type = init_type (TYPE_CODE_INT,
371 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
372 TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
373 break;
374 case FT_FLOAT:
375 type = init_type (TYPE_CODE_FLT,
376 TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
377 0, "float", objfile);
378 break;
379 case FT_DBL_PREC_FLOAT:
380 type = init_type (TYPE_CODE_FLT,
381 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
382 0, "double", objfile);
383 break;
384 case FT_EXT_PREC_FLOAT:
385 type = init_type (TYPE_CODE_FLT,
386 TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
387 0, "extended", objfile);
388 break;
389 }
390 return (type);
391 }
392 \f
393
394 /* Table mapping opcodes into strings for printing operators
395 and precedences of the operators. */
396
397 const struct op_print pascal_op_print_tab[] =
398 {
399 {",", BINOP_COMMA, PREC_COMMA, 0},
400 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
401 {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
402 {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
403 {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
404 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
405 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
406 {"<=", BINOP_LEQ, PREC_ORDER, 0},
407 {">=", BINOP_GEQ, PREC_ORDER, 0},
408 {">", BINOP_GTR, PREC_ORDER, 0},
409 {"<", BINOP_LESS, PREC_ORDER, 0},
410 {"shr", BINOP_RSH, PREC_SHIFT, 0},
411 {"shl", BINOP_LSH, PREC_SHIFT, 0},
412 {"+", BINOP_ADD, PREC_ADD, 0},
413 {"-", BINOP_SUB, PREC_ADD, 0},
414 {"*", BINOP_MUL, PREC_MUL, 0},
415 {"/", BINOP_DIV, PREC_MUL, 0},
416 {"div", BINOP_INTDIV, PREC_MUL, 0},
417 {"mod", BINOP_REM, PREC_MUL, 0},
418 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
419 {"-", UNOP_NEG, PREC_PREFIX, 0},
420 {"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
421 {"^", UNOP_IND, PREC_SUFFIX, 1},
422 {"@", UNOP_ADDR, PREC_PREFIX, 0},
423 {"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0},
424 {NULL, 0, 0, 0}
425 };
426 \f
427 struct type **const (pascal_builtin_types[]) =
428 {
429 &builtin_type_int,
430 &builtin_type_long,
431 &builtin_type_short,
432 &builtin_type_char,
433 &builtin_type_float,
434 &builtin_type_double,
435 &builtin_type_void,
436 &builtin_type_long_long,
437 &builtin_type_signed_char,
438 &builtin_type_unsigned_char,
439 &builtin_type_unsigned_short,
440 &builtin_type_unsigned_int,
441 &builtin_type_unsigned_long,
442 &builtin_type_unsigned_long_long,
443 &builtin_type_long_double,
444 &builtin_type_complex,
445 &builtin_type_double_complex,
446 0
447 };
448
449 const struct language_defn pascal_language_defn =
450 {
451 "pascal", /* Language name */
452 language_pascal,
453 pascal_builtin_types,
454 range_check_on,
455 type_check_on,
456 case_sensitive_on,
457 array_row_major,
458 &exp_descriptor_standard,
459 pascal_parse,
460 pascal_error,
461 null_post_parser,
462 pascal_printchar, /* Print a character constant */
463 pascal_printstr, /* Function to print string constant */
464 pascal_emit_char, /* Print a single char */
465 pascal_create_fundamental_type, /* Create fundamental type in this language */
466 pascal_print_type, /* Print a type using appropriate syntax */
467 pascal_val_print, /* Print a value using appropriate syntax */
468 pascal_value_print, /* Print a top-level value */
469 NULL, /* Language specific skip_trampoline */
470 value_of_this, /* value_of_this */
471 basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
472 basic_lookup_transparent_type,/* lookup_transparent_type */
473 NULL, /* Language specific symbol demangler */
474 NULL, /* Language specific class_name_from_physname */
475 pascal_op_print_tab, /* expression operators for printing */
476 1, /* c-style arrays */
477 0, /* String lower bound */
478 &builtin_type_char, /* Type of string elements */
479 default_word_break_characters,
480 NULL, /* FIXME: la_language_arch_info. */
481 default_print_array_index,
482 LANG_MAGIC
483 };
484
485 void
486 _initialize_pascal_language (void)
487 {
488 add_language (&pascal_language_defn);
489 }