]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blob - gdb/p-lang.c
2000-06-14 Pierre Muller <muller@ics.u-strasbg.fr>
[thirdparty/binutils-gdb.git] / gdb / p-lang.c
1 /* Pascal language support routines for GDB, the GNU debugger.
2 Copyright 2000 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 p-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
31 extern void _initialize_pascal_language (void);
32 static void pascal_one_char (int, struct ui_file *, int *);
33
34 /* Print the character C on STREAM as part of the contents of a literal
35 string.
36 In_quotes is reset to 0 if a char is written with #4 notation */
37
38 static void
39 pascal_one_char (c, stream, in_quotes)
40 register int c;
41 struct ui_file *stream;
42 int *in_quotes;
43 {
44
45 c &= 0xFF; /* Avoid sign bit follies */
46
47 if ((c == '\'') || (PRINT_LITERAL_FORM (c)))
48 {
49 if (!(*in_quotes))
50 fputs_filtered ("'", stream);
51 *in_quotes = 1;
52 if (c == '\'')
53 {
54 fputs_filtered ("''", stream);
55 }
56 else
57 fprintf_filtered (stream, "%c", c);
58 }
59 else
60 {
61 if (*in_quotes)
62 fputs_filtered ("'", stream);
63 *in_quotes = 0;
64 fprintf_filtered (stream, "#%d", (unsigned int) c);
65 }
66 }
67
68 static void pascal_emit_char (int c, struct ui_file *stream, int quoter);
69
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. */
73
74 static void
75 pascal_emit_char (c, stream, quoter)
76 register int c;
77 struct ui_file *stream;
78 int quoter;
79 {
80 int in_quotes = 0;
81 pascal_one_char (c, stream, &in_quotes);
82 if (in_quotes)
83 fputs_filtered ("'", stream);
84 }
85
86 void
87 pascal_printchar (c, stream)
88 int c;
89 struct ui_file *stream;
90 {
91 int in_quotes = 0;
92 pascal_one_char (c, stream, &in_quotes);
93 if (in_quotes)
94 fputs_filtered ("'", stream);
95 }
96
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. */
101
102 void
103 pascal_printstr (stream, string, length, width, force_ellipses)
104 struct ui_file *stream;
105 char *string;
106 unsigned int length;
107 int width;
108 int force_ellipses;
109 {
110 register unsigned int i;
111 unsigned int things_printed = 0;
112 int in_quotes = 0;
113 int need_comma = 0;
114 extern int inspect_it;
115
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
118 style. */
119 if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
120 length--;
121
122 if (length == 0)
123 {
124 fputs_filtered ("''", stream);
125 return;
126 }
127
128 for (i = 0; i < length && things_printed < print_max; ++i)
129 {
130 /* Position of the character we are examining
131 to see whether it is repeated. */
132 unsigned int rep1;
133 /* Number of repetitions we have detected so far. */
134 unsigned int reps;
135
136 QUIT;
137
138 if (need_comma)
139 {
140 fputs_filtered (", ", stream);
141 need_comma = 0;
142 }
143
144 rep1 = i + 1;
145 reps = 1;
146 while (rep1 < length && string[rep1] == string[i])
147 {
148 ++rep1;
149 ++reps;
150 }
151
152 if (reps > repeat_count_threshold)
153 {
154 if (in_quotes)
155 {
156 if (inspect_it)
157 fputs_filtered ("\\', ", stream);
158 else
159 fputs_filtered ("', ", stream);
160 in_quotes = 0;
161 }
162 pascal_printchar (string[i], stream);
163 fprintf_filtered (stream, " <repeats %u times>", reps);
164 i = rep1 - 1;
165 things_printed += repeat_count_threshold;
166 need_comma = 1;
167 }
168 else
169 {
170 int c = string[i];
171 if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
172 {
173 if (inspect_it)
174 fputs_filtered ("\\'", stream);
175 else
176 fputs_filtered ("'", stream);
177 in_quotes = 1;
178 }
179 pascal_one_char (c, stream, &in_quotes);
180 ++things_printed;
181 }
182 }
183
184 /* Terminate the quotes if necessary. */
185 if (in_quotes)
186 {
187 if (inspect_it)
188 fputs_filtered ("\\'", stream);
189 else
190 fputs_filtered ("'", stream);
191 }
192
193 if (force_ellipses || i < length)
194 fputs_filtered ("...", stream);
195 }
196
197 /* Create a fundamental Pascal type using default reasonable for the current
198 target machine.
199
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
204 function.
205
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 */
219
220 /* Note there might be some discussion about the choosen correspondance
221 because it mainly reflects Free Pascal Compiler setup for now PM */
222
223
224 struct type *
225 pascal_create_fundamental_type (objfile, typeid)
226 struct objfile *objfile;
227 int typeid;
228 {
229 register struct type *type = NULL;
230
231 switch (typeid)
232 {
233 default:
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);
242 break;
243 case FT_VOID:
244 type = init_type (TYPE_CODE_VOID,
245 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
246 0, "void", objfile);
247 break;
248 case FT_CHAR:
249 type = init_type (TYPE_CODE_INT,
250 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
251 0, "char", objfile);
252 break;
253 case FT_SIGNED_CHAR:
254 type = init_type (TYPE_CODE_INT,
255 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
256 0, "shortint", objfile);
257 break;
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);
262 break;
263 case FT_SHORT:
264 type = init_type (TYPE_CODE_INT,
265 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
266 0, "integer", objfile);
267 break;
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 */
272 break;
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);
277 break;
278 case FT_INTEGER:
279 type = init_type (TYPE_CODE_INT,
280 TARGET_INT_BIT / TARGET_CHAR_BIT,
281 0, "longint", objfile);
282 break;
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 */
287 break;
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);
292 break;
293 case FT_LONG:
294 type = init_type (TYPE_CODE_INT,
295 TARGET_LONG_BIT / TARGET_CHAR_BIT,
296 0, "long", objfile);
297 break;
298 case FT_SIGNED_LONG:
299 type = init_type (TYPE_CODE_INT,
300 TARGET_LONG_BIT / TARGET_CHAR_BIT,
301 0, "long", objfile); /* FIXME -fnf */
302 break;
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);
307 break;
308 case FT_LONG_LONG:
309 type = init_type (TYPE_CODE_INT,
310 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
311 0, "long long", objfile);
312 break;
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);
317 break;
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);
322 break;
323 case FT_FLOAT:
324 type = init_type (TYPE_CODE_FLT,
325 TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
326 0, "float", objfile);
327 break;
328 case FT_DBL_PREC_FLOAT:
329 type = init_type (TYPE_CODE_FLT,
330 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
331 0, "double", objfile);
332 break;
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);
337 break;
338 }
339 return (type);
340 }
341 \f
342
343 /* Table mapping opcodes into strings for printing operators
344 and precedences of the operators. */
345
346 const struct op_print pascal_op_print_tab[] =
347 {
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},
373 {NULL, 0, 0, 0}
374 };
375 \f
376 struct type **const /* CONST_PTR v 4.17 */ (pascal_builtin_types[]) =
377 {
378 &builtin_type_int,
379 &builtin_type_long,
380 &builtin_type_short,
381 &builtin_type_char,
382 &builtin_type_float,
383 &builtin_type_double,
384 &builtin_type_void,
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,
395 0
396 };
397
398 const struct language_defn pascal_language_defn =
399 {
400 "pascal", /* Language name */
401 language_pascal,
402 pascal_builtin_types,
403 range_check_on,
404 type_check_on,
405 pascal_parse,
406 pascal_error,
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 */
423 LANG_MAGIC
424 };
425
426 void
427 _initialize_pascal_language ()
428 {
429 add_language (&pascal_language_defn);
430 }