]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blob - gdb/p-lang.c
2002-02-13 Michael Chastain <mec@shout.net>
[thirdparty/binutils-gdb.git] / gdb / p-lang.c
1 /* Pascal language support routines for GDB, the GNU debugger.
2 Copyright 2000, 2002 Free Software Foundation, Inc.
3
4 This file is part of GDB.
5
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.
10
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.
15
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. */
19
20 /* This file is derived from c-lang.c */
21
22 #include "defs.h"
23 #include "symtab.h"
24 #include "gdbtypes.h"
25 #include "expression.h"
26 #include "parser-defs.h"
27 #include "language.h"
28 #include "p-lang.h"
29 #include "valprint.h"
30 #include <ctype.h>
31
32 extern void _initialize_pascal_language (void);
33
34
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. */
45 int
46 is_pascal_string_type (struct type *type,int *length_pos,
47 int * length_size, int *string_pos, int *char_size)
48 {
49 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
50 {
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)
56 {
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;
60 *char_size = 1;
61 return 1;
62 };
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)
68 {
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 ?? */
73 *char_size = 1;
74 return 1;
75 };
76 }
77 return 0;
78 }
79
80 static void pascal_one_char (int, struct ui_file *, int *);
81
82 /* Print the character C on STREAM as part of the contents of a literal
83 string.
84 In_quotes is reset to 0 if a char is written with #4 notation */
85
86 static void
87 pascal_one_char (register int c, struct ui_file *stream, int *in_quotes)
88 {
89
90 c &= 0xFF; /* Avoid sign bit follies */
91
92 if ((c == '\'') || (PRINT_LITERAL_FORM (c)))
93 {
94 if (!(*in_quotes))
95 fputs_filtered ("'", stream);
96 *in_quotes = 1;
97 if (c == '\'')
98 {
99 fputs_filtered ("''", stream);
100 }
101 else
102 fprintf_filtered (stream, "%c", c);
103 }
104 else
105 {
106 if (*in_quotes)
107 fputs_filtered ("'", stream);
108 *in_quotes = 0;
109 fprintf_filtered (stream, "#%d", (unsigned int) c);
110 }
111 }
112
113 static void pascal_emit_char (int c, struct ui_file *stream, int quoter);
114
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. */
118
119 static void
120 pascal_emit_char (register int c, struct ui_file *stream, int quoter)
121 {
122 int in_quotes = 0;
123 pascal_one_char (c, stream, &in_quotes);
124 if (in_quotes)
125 fputs_filtered ("'", stream);
126 }
127
128 void
129 pascal_printchar (int c, struct ui_file *stream)
130 {
131 int in_quotes = 0;
132 pascal_one_char (c, stream, &in_quotes);
133 if (in_quotes)
134 fputs_filtered ("'", stream);
135 }
136
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. */
141
142 void
143 pascal_printstr (struct ui_file *stream, char *string, unsigned int length,
144 int width, int force_ellipses)
145 {
146 register unsigned int i;
147 unsigned int things_printed = 0;
148 int in_quotes = 0;
149 int need_comma = 0;
150 extern int inspect_it;
151
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
154 style. */
155 if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
156 length--;
157
158 if (length == 0)
159 {
160 fputs_filtered ("''", stream);
161 return;
162 }
163
164 for (i = 0; i < length && things_printed < print_max; ++i)
165 {
166 /* Position of the character we are examining
167 to see whether it is repeated. */
168 unsigned int rep1;
169 /* Number of repetitions we have detected so far. */
170 unsigned int reps;
171
172 QUIT;
173
174 if (need_comma)
175 {
176 fputs_filtered (", ", stream);
177 need_comma = 0;
178 }
179
180 rep1 = i + 1;
181 reps = 1;
182 while (rep1 < length && string[rep1] == string[i])
183 {
184 ++rep1;
185 ++reps;
186 }
187
188 if (reps > repeat_count_threshold)
189 {
190 if (in_quotes)
191 {
192 if (inspect_it)
193 fputs_filtered ("\\', ", stream);
194 else
195 fputs_filtered ("', ", stream);
196 in_quotes = 0;
197 }
198 pascal_printchar (string[i], stream);
199 fprintf_filtered (stream, " <repeats %u times>", reps);
200 i = rep1 - 1;
201 things_printed += repeat_count_threshold;
202 need_comma = 1;
203 }
204 else
205 {
206 int c = string[i];
207 if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
208 {
209 if (inspect_it)
210 fputs_filtered ("\\'", stream);
211 else
212 fputs_filtered ("'", stream);
213 in_quotes = 1;
214 }
215 pascal_one_char (c, stream, &in_quotes);
216 ++things_printed;
217 }
218 }
219
220 /* Terminate the quotes if necessary. */
221 if (in_quotes)
222 {
223 if (inspect_it)
224 fputs_filtered ("\\'", stream);
225 else
226 fputs_filtered ("'", stream);
227 }
228
229 if (force_ellipses || i < length)
230 fputs_filtered ("...", stream);
231 }
232
233 /* Create a fundamental Pascal type using default reasonable for the current
234 target machine.
235
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
240 function.
241
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 */
255
256 /* Note there might be some discussion about the choosen correspondance
257 because it mainly reflects Free Pascal Compiler setup for now PM */
258
259
260 struct type *
261 pascal_create_fundamental_type (struct objfile *objfile, int typeid)
262 {
263 register struct type *type = NULL;
264
265 switch (typeid)
266 {
267 default:
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);
276 break;
277 case FT_VOID:
278 type = init_type (TYPE_CODE_VOID,
279 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
280 0, "void", objfile);
281 break;
282 case FT_CHAR:
283 type = init_type (TYPE_CODE_INT,
284 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
285 0, "char", objfile);
286 break;
287 case FT_SIGNED_CHAR:
288 type = init_type (TYPE_CODE_INT,
289 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
290 0, "shortint", objfile);
291 break;
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);
296 break;
297 case FT_SHORT:
298 type = init_type (TYPE_CODE_INT,
299 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
300 0, "integer", objfile);
301 break;
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 */
306 break;
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);
311 break;
312 case FT_INTEGER:
313 type = init_type (TYPE_CODE_INT,
314 TARGET_INT_BIT / TARGET_CHAR_BIT,
315 0, "longint", objfile);
316 break;
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 */
321 break;
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);
326 break;
327 case FT_LONG:
328 type = init_type (TYPE_CODE_INT,
329 TARGET_LONG_BIT / TARGET_CHAR_BIT,
330 0, "long", objfile);
331 break;
332 case FT_SIGNED_LONG:
333 type = init_type (TYPE_CODE_INT,
334 TARGET_LONG_BIT / TARGET_CHAR_BIT,
335 0, "long", objfile); /* FIXME -fnf */
336 break;
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);
341 break;
342 case FT_LONG_LONG:
343 type = init_type (TYPE_CODE_INT,
344 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
345 0, "long long", objfile);
346 break;
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);
351 break;
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);
356 break;
357 case FT_FLOAT:
358 type = init_type (TYPE_CODE_FLT,
359 TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
360 0, "float", objfile);
361 break;
362 case FT_DBL_PREC_FLOAT:
363 type = init_type (TYPE_CODE_FLT,
364 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
365 0, "double", objfile);
366 break;
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);
371 break;
372 }
373 return (type);
374 }
375 \f
376
377 /* Table mapping opcodes into strings for printing operators
378 and precedences of the operators. */
379
380 const struct op_print pascal_op_print_tab[] =
381 {
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},
407 {NULL, 0, 0, 0}
408 };
409 \f
410 struct type **const (pascal_builtin_types[]) =
411 {
412 &builtin_type_int,
413 &builtin_type_long,
414 &builtin_type_short,
415 &builtin_type_char,
416 &builtin_type_float,
417 &builtin_type_double,
418 &builtin_type_void,
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,
429 0
430 };
431
432 const struct language_defn pascal_language_defn =
433 {
434 "pascal", /* Language name */
435 language_pascal,
436 pascal_builtin_types,
437 range_check_on,
438 type_check_on,
439 case_sensitive_on,
440 pascal_parse,
441 pascal_error,
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 */
458 LANG_MAGIC
459 };
460
461 void
462 _initialize_pascal_language (void)
463 {
464 add_language (&pascal_language_defn);
465 }