Commit | Line | Data |
---|---|---|
373a8247 | 1 | /* Pascal language support routines for GDB, the GNU debugger. |
ce27fb25 | 2 | |
3666a048 | 3 | Copyright (C) 2000-2021 Free Software Foundation, Inc. |
373a8247 PM |
4 | |
5 | This file is part of GDB. | |
6 | ||
7 | This program is free software; you can redistribute it and/or modify | |
8 | it under the terms of the GNU General Public License as published by | |
a9762ec7 | 9 | the Free Software Foundation; either version 3 of the License, or |
373a8247 PM |
10 | (at your option) any later version. |
11 | ||
12 | This program is distributed in the hope that it will be useful, | |
13 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | GNU General Public License for more details. | |
16 | ||
17 | You should have received a copy of the GNU General Public License | |
a9762ec7 | 18 | along with this program. If not, see <http://www.gnu.org/licenses/>. */ |
373a8247 | 19 | |
5598ce11 | 20 | /* This file is derived from c-lang.c */ |
373a8247 PM |
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" | |
a53b64ea | 28 | #include "varobj.h" |
373a8247 PM |
29 | #include "p-lang.h" |
30 | #include "valprint.h" | |
5f9a71c3 | 31 | #include "value.h" |
5598ce11 | 32 | #include <ctype.h> |
43cc5389 | 33 | #include "c-lang.h" |
0d12e84c | 34 | #include "gdbarch.h" |
7f6aba03 | 35 | #include "cli/cli-style.h" |
6ced1581 | 36 | |
cd6c7346 | 37 | /* All GPC versions until now (2007-09-27) also define a symbol called |
0df8b418 | 38 | '_p_initialize'. Check for the presence of this symbol first. */ |
cd6c7346 PM |
39 | static const char GPC_P_INITIALIZE[] = "_p_initialize"; |
40 | ||
41 | /* The name of the symbol that GPC uses as the name of the main | |
42 | procedure (since version 20050212). */ | |
43 | static const char GPC_MAIN_PROGRAM_NAME_1[] = "_p__M0_main_program"; | |
44 | ||
45 | /* Older versions of GPC (versions older than 20050212) were using | |
46 | a different name for the main procedure. */ | |
47 | static const char GPC_MAIN_PROGRAM_NAME_2[] = "pascal_main_program"; | |
48 | ||
49 | /* Function returning the special symbol name used | |
50 | by GPC for the main procedure in the main program | |
51 | if it is found in minimal symbol list. | |
52 | This function tries to find minimal symbols generated by GPC | |
53 | so that it finds the even if the program was compiled | |
54 | without debugging information. | |
55 | According to information supplied by Waldeck Hebisch, | |
0df8b418 | 56 | this should work for all versions posterior to June 2000. */ |
cd6c7346 PM |
57 | |
58 | const char * | |
59 | pascal_main_name (void) | |
60 | { | |
3b7344d5 | 61 | struct bound_minimal_symbol msym; |
cd6c7346 PM |
62 | |
63 | msym = lookup_minimal_symbol (GPC_P_INITIALIZE, NULL, NULL); | |
64 | ||
65 | /* If '_p_initialize' was not found, the main program is likely not | |
66 | written in Pascal. */ | |
3b7344d5 | 67 | if (msym.minsym == NULL) |
cd6c7346 PM |
68 | return NULL; |
69 | ||
70 | msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_1, NULL, NULL); | |
3b7344d5 | 71 | if (msym.minsym != NULL) |
cd6c7346 PM |
72 | { |
73 | return GPC_MAIN_PROGRAM_NAME_1; | |
74 | } | |
75 | ||
76 | msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_2, NULL, NULL); | |
3b7344d5 | 77 | if (msym.minsym != NULL) |
cd6c7346 PM |
78 | { |
79 | return GPC_MAIN_PROGRAM_NAME_2; | |
80 | } | |
81 | ||
82 | /* No known entry procedure found, the main program is probably | |
83 | not compiled with GPC. */ | |
84 | return NULL; | |
85 | } | |
86 | ||
46157d77 AB |
87 | /* See p-lang.h. */ |
88 | ||
5598ce11 | 89 | int |
46157d77 AB |
90 | pascal_is_string_type (struct type *type,int *length_pos, int *length_size, |
91 | int *string_pos, struct type **char_type, | |
0d5cff50 | 92 | const char **arrayname) |
5598ce11 | 93 | { |
78134374 | 94 | if (type != NULL && type->code () == TYPE_CODE_STRUCT) |
5598ce11 PM |
95 | { |
96 | /* Old Borland type pascal strings from Free Pascal Compiler. */ | |
97 | /* Two fields: length and st. */ | |
1f704f76 | 98 | if (type->num_fields () == 2 |
dae71413 | 99 | && TYPE_FIELD_NAME (type, 0) |
6ced1581 | 100 | && strcmp (TYPE_FIELD_NAME (type, 0), "length") == 0 |
dae71413 PM |
101 | && TYPE_FIELD_NAME (type, 1) |
102 | && strcmp (TYPE_FIELD_NAME (type, 1), "st") == 0) | |
dda83cd7 SM |
103 | { |
104 | if (length_pos) | |
e2625b33 | 105 | *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT; |
dda83cd7 | 106 | if (length_size) |
940da03e | 107 | *length_size = TYPE_LENGTH (type->field (0).type ()); |
dda83cd7 | 108 | if (string_pos) |
e2625b33 | 109 | *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; |
dda83cd7 | 110 | if (char_type) |
940da03e | 111 | *char_type = TYPE_TARGET_TYPE (type->field (1).type ()); |
e2625b33 | 112 | if (arrayname) |
dae71413 | 113 | *arrayname = TYPE_FIELD_NAME (type, 1); |
dda83cd7 SM |
114 | return 2; |
115 | }; | |
5598ce11 PM |
116 | /* GNU pascal strings. */ |
117 | /* Three fields: Capacity, length and schema$ or _p_schema. */ | |
1f704f76 | 118 | if (type->num_fields () == 3 |
dae71413 PM |
119 | && TYPE_FIELD_NAME (type, 0) |
120 | && strcmp (TYPE_FIELD_NAME (type, 0), "Capacity") == 0 | |
121 | && TYPE_FIELD_NAME (type, 1) | |
122 | && strcmp (TYPE_FIELD_NAME (type, 1), "length") == 0) | |
dda83cd7 | 123 | { |
58159490 | 124 | if (length_pos) |
e2625b33 | 125 | *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; |
58159490 | 126 | if (length_size) |
940da03e | 127 | *length_size = TYPE_LENGTH (type->field (1).type ()); |
58159490 | 128 | if (string_pos) |
e2625b33 | 129 | *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT; |
dda83cd7 SM |
130 | /* FIXME: how can I detect wide chars in GPC ?? */ |
131 | if (char_type) | |
58159490 | 132 | { |
940da03e | 133 | *char_type = TYPE_TARGET_TYPE (type->field (2).type ()); |
ad3bbd48 | 134 | |
78134374 | 135 | if ((*char_type)->code () == TYPE_CODE_ARRAY) |
6c7a06a3 | 136 | *char_type = TYPE_TARGET_TYPE (*char_type); |
58159490 | 137 | } |
e2625b33 | 138 | if (arrayname) |
dae71413 | 139 | *arrayname = TYPE_FIELD_NAME (type, 2); |
dda83cd7 SM |
140 | return 3; |
141 | }; | |
5598ce11 PM |
142 | } |
143 | return 0; | |
144 | } | |
145 | ||
46157d77 | 146 | /* See p-lang.h. */ |
373a8247 | 147 | |
46157d77 AB |
148 | void |
149 | pascal_language::print_one_char (int c, struct ui_file *stream, | |
150 | int *in_quotes) const | |
373a8247 | 151 | { |
9b79b476 | 152 | if (c == '\'' || ((unsigned int) c <= 0xff && (PRINT_LITERAL_FORM (c)))) |
373a8247 PM |
153 | { |
154 | if (!(*in_quotes)) | |
155 | fputs_filtered ("'", stream); | |
156 | *in_quotes = 1; | |
157 | if (c == '\'') | |
158 | { | |
159 | fputs_filtered ("''", stream); | |
160 | } | |
161 | else | |
162 | fprintf_filtered (stream, "%c", c); | |
163 | } | |
164 | else | |
165 | { | |
166 | if (*in_quotes) | |
167 | fputs_filtered ("'", stream); | |
168 | *in_quotes = 0; | |
169 | fprintf_filtered (stream, "#%d", (unsigned int) c); | |
170 | } | |
171 | } | |
172 | ||
46157d77 AB |
173 | /* See language.h. */ |
174 | ||
373a8247 | 175 | void |
46157d77 AB |
176 | pascal_language::printchar (int c, struct type *type, |
177 | struct ui_file *stream) const | |
373a8247 PM |
178 | { |
179 | int in_quotes = 0; | |
ad3bbd48 | 180 | |
46157d77 | 181 | print_one_char (c, stream, &in_quotes); |
373a8247 PM |
182 | if (in_quotes) |
183 | fputs_filtered ("'", stream); | |
184 | } | |
185 | ||
373a8247 PM |
186 | \f |
187 | ||
46157d77 | 188 | /* See language.h. */ |
0874fd07 | 189 | |
46157d77 AB |
190 | void pascal_language::language_arch_info |
191 | (struct gdbarch *gdbarch, struct language_arch_info *lai) const | |
0874fd07 | 192 | { |
46157d77 | 193 | const struct builtin_type *builtin = builtin_type (gdbarch); |
52b50f2c | 194 | |
46157d77 AB |
195 | /* Helper function to allow shorter lines below. */ |
196 | auto add = [&] (struct type * t) | |
52b50f2c | 197 | { |
46157d77 AB |
198 | lai->add_primitive_type (t); |
199 | }; | |
200 | ||
201 | add (builtin->builtin_int); | |
202 | add (builtin->builtin_long); | |
203 | add (builtin->builtin_short); | |
204 | add (builtin->builtin_char); | |
205 | add (builtin->builtin_float); | |
206 | add (builtin->builtin_double); | |
207 | add (builtin->builtin_void); | |
208 | add (builtin->builtin_long_long); | |
209 | add (builtin->builtin_signed_char); | |
210 | add (builtin->builtin_unsigned_char); | |
211 | add (builtin->builtin_unsigned_short); | |
212 | add (builtin->builtin_unsigned_int); | |
213 | add (builtin->builtin_unsigned_long); | |
214 | add (builtin->builtin_unsigned_long_long); | |
215 | add (builtin->builtin_long_double); | |
216 | add (builtin->builtin_complex); | |
217 | add (builtin->builtin_double_complex); | |
218 | ||
219 | lai->set_string_char_type (builtin->builtin_char); | |
220 | lai->set_bool_type (builtin->builtin_bool, "boolean"); | |
221 | } | |
52b50f2c | 222 | |
46157d77 | 223 | /* See language.h. */ |
d711ee67 | 224 | |
46157d77 AB |
225 | void |
226 | pascal_language::printstr (struct ui_file *stream, struct type *elttype, | |
227 | const gdb_byte *string, unsigned int length, | |
228 | const char *encoding, int force_ellipses, | |
229 | const struct value_print_options *options) const | |
230 | { | |
231 | enum bfd_endian byte_order = type_byte_order (elttype); | |
232 | unsigned int i; | |
233 | unsigned int things_printed = 0; | |
234 | int in_quotes = 0; | |
235 | int need_comma = 0; | |
236 | int width; | |
237 | ||
238 | /* Preserve ELTTYPE's original type, just set its LENGTH. */ | |
239 | check_typedef (elttype); | |
240 | width = TYPE_LENGTH (elttype); | |
241 | ||
242 | /* If the string was not truncated due to `set print elements', and | |
243 | the last byte of it is a null, we don't print that, in traditional C | |
244 | style. */ | |
245 | if ((!force_ellipses) && length > 0 | |
246 | && extract_unsigned_integer (string + (length - 1) * width, width, | |
247 | byte_order) == 0) | |
248 | length--; | |
249 | ||
250 | if (length == 0) | |
251 | { | |
252 | fputs_filtered ("''", stream); | |
253 | return; | |
254 | } | |
4ffc13fb | 255 | |
46157d77 AB |
256 | for (i = 0; i < length && things_printed < options->print_max; ++i) |
257 | { | |
258 | /* Position of the character we are examining | |
259 | to see whether it is repeated. */ | |
260 | unsigned int rep1; | |
261 | /* Number of repetitions we have detected so far. */ | |
262 | unsigned int reps; | |
263 | unsigned long int current_char; | |
39e7ecca | 264 | |
46157d77 | 265 | QUIT; |
5bae7c4e | 266 | |
46157d77 AB |
267 | if (need_comma) |
268 | { | |
269 | fputs_filtered (", ", stream); | |
270 | need_comma = 0; | |
271 | } | |
5bae7c4e | 272 | |
46157d77 AB |
273 | current_char = extract_unsigned_integer (string + i * width, width, |
274 | byte_order); | |
efdf6a73 | 275 | |
46157d77 AB |
276 | rep1 = i + 1; |
277 | reps = 1; | |
278 | while (rep1 < length | |
279 | && extract_unsigned_integer (string + rep1 * width, width, | |
280 | byte_order) == current_char) | |
281 | { | |
282 | ++rep1; | |
283 | ++reps; | |
284 | } | |
efdf6a73 | 285 | |
46157d77 AB |
286 | if (reps > options->repeat_count_threshold) |
287 | { | |
288 | if (in_quotes) | |
289 | { | |
290 | fputs_filtered ("', ", stream); | |
291 | in_quotes = 0; | |
292 | } | |
293 | printchar (current_char, elttype, stream); | |
294 | fprintf_filtered (stream, " %p[<repeats %u times>%p]", | |
295 | metadata_style.style ().ptr (), | |
296 | reps, nullptr); | |
297 | i = rep1 - 1; | |
298 | things_printed += options->repeat_count_threshold; | |
299 | need_comma = 1; | |
300 | } | |
301 | else | |
302 | { | |
303 | if ((!in_quotes) && (PRINT_LITERAL_FORM (current_char))) | |
304 | { | |
305 | fputs_filtered ("'", stream); | |
306 | in_quotes = 1; | |
307 | } | |
308 | print_one_char (current_char, stream, &in_quotes); | |
309 | ++things_printed; | |
310 | } | |
311 | } | |
b7c6e27d | 312 | |
46157d77 AB |
313 | /* Terminate the quotes if necessary. */ |
314 | if (in_quotes) | |
315 | fputs_filtered ("'", stream); | |
b7c6e27d | 316 | |
46157d77 AB |
317 | if (force_ellipses || i < length) |
318 | fputs_filtered ("...", stream); | |
319 | } | |
0874fd07 AB |
320 | |
321 | /* Single instance of the Pascal language class. */ | |
322 | ||
323 | static pascal_language pascal_language_defn; |