Commit | Line | Data |
---|---|---|
c906108c | 1 | /* Modula 2 language support routines for GDB, the GNU debugger. |
ce27fb25 | 2 | |
6aba47ca DJ |
3 | Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004, |
4 | 2005, 2007 Free Software Foundation, Inc. | |
c906108c | 5 | |
c5aa993b | 6 | This file is part of GDB. |
c906108c | 7 | |
c5aa993b JM |
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 | |
a9762ec7 | 10 | the Free Software Foundation; either version 3 of the License, or |
c5aa993b | 11 | (at your option) any later version. |
c906108c | 12 | |
c5aa993b JM |
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. | |
c906108c | 17 | |
c5aa993b | 18 | You should have received a copy of the GNU General Public License |
a9762ec7 | 19 | along with this program. If not, see <http://www.gnu.org/licenses/>. */ |
c906108c SS |
20 | |
21 | #include "defs.h" | |
22 | #include "symtab.h" | |
23 | #include "gdbtypes.h" | |
24 | #include "expression.h" | |
25 | #include "parser-defs.h" | |
26 | #include "language.h" | |
27 | #include "m2-lang.h" | |
28 | #include "c-lang.h" | |
745b8ca0 | 29 | #include "valprint.h" |
c906108c | 30 | |
a14ed312 KB |
31 | extern void _initialize_m2_language (void); |
32 | static struct type *m2_create_fundamental_type (struct objfile *, int); | |
d9fcf2fb JM |
33 | static void m2_printchar (int, struct ui_file *); |
34 | static void m2_emit_char (int, struct ui_file *, int); | |
c906108c SS |
35 | |
36 | /* Print the character C on STREAM as part of the contents of a literal | |
37 | string whose delimiter is QUOTER. Note that that format for printing | |
38 | characters and strings is language specific. | |
39 | FIXME: This is a copy of the same function from c-exp.y. It should | |
844781a1 | 40 | be replaced with a true Modula version. */ |
c906108c SS |
41 | |
42 | static void | |
f86f5ca3 | 43 | m2_emit_char (int c, struct ui_file *stream, int quoter) |
c906108c SS |
44 | { |
45 | ||
46 | c &= 0xFF; /* Avoid sign bit follies */ | |
47 | ||
48 | if (PRINT_LITERAL_FORM (c)) | |
49 | { | |
50 | if (c == '\\' || c == quoter) | |
51 | { | |
52 | fputs_filtered ("\\", stream); | |
53 | } | |
54 | fprintf_filtered (stream, "%c", c); | |
55 | } | |
56 | else | |
57 | { | |
58 | switch (c) | |
59 | { | |
60 | case '\n': | |
61 | fputs_filtered ("\\n", stream); | |
62 | break; | |
63 | case '\b': | |
64 | fputs_filtered ("\\b", stream); | |
65 | break; | |
66 | case '\t': | |
67 | fputs_filtered ("\\t", stream); | |
68 | break; | |
69 | case '\f': | |
70 | fputs_filtered ("\\f", stream); | |
71 | break; | |
72 | case '\r': | |
73 | fputs_filtered ("\\r", stream); | |
74 | break; | |
75 | case '\033': | |
76 | fputs_filtered ("\\e", stream); | |
77 | break; | |
78 | case '\007': | |
79 | fputs_filtered ("\\a", stream); | |
80 | break; | |
81 | default: | |
82 | fprintf_filtered (stream, "\\%.3o", (unsigned int) c); | |
83 | break; | |
84 | } | |
85 | } | |
86 | } | |
87 | ||
88 | /* FIXME: This is a copy of the same function from c-exp.y. It should | |
844781a1 | 89 | be replaced with a true Modula version. */ |
c906108c SS |
90 | |
91 | static void | |
fba45db2 | 92 | m2_printchar (int c, struct ui_file *stream) |
c906108c SS |
93 | { |
94 | fputs_filtered ("'", stream); | |
95 | LA_EMIT_CHAR (c, stream, '\''); | |
96 | fputs_filtered ("'", stream); | |
97 | } | |
98 | ||
99 | /* Print the character string STRING, printing at most LENGTH characters. | |
100 | Printing stops early if the number hits print_max; repeat counts | |
101 | are printed as appropriate. Print ellipses at the end if we | |
102 | had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. | |
103 | FIXME: This is a copy of the same function from c-exp.y. It should | |
844781a1 | 104 | be replaced with a true Modula version. */ |
c906108c SS |
105 | |
106 | static void | |
fc1a4b47 | 107 | m2_printstr (struct ui_file *stream, const gdb_byte *string, |
ce27fb25 | 108 | unsigned int length, int width, int force_ellipses) |
c906108c | 109 | { |
f86f5ca3 | 110 | unsigned int i; |
c906108c SS |
111 | unsigned int things_printed = 0; |
112 | int in_quotes = 0; | |
113 | int need_comma = 0; | |
c906108c SS |
114 | |
115 | if (length == 0) | |
116 | { | |
117 | fputs_filtered ("\"\"", gdb_stdout); | |
118 | return; | |
119 | } | |
120 | ||
121 | for (i = 0; i < length && things_printed < print_max; ++i) | |
122 | { | |
123 | /* Position of the character we are examining | |
c5aa993b | 124 | to see whether it is repeated. */ |
c906108c SS |
125 | unsigned int rep1; |
126 | /* Number of repetitions we have detected so far. */ | |
127 | unsigned int reps; | |
128 | ||
129 | QUIT; | |
130 | ||
131 | if (need_comma) | |
132 | { | |
133 | fputs_filtered (", ", stream); | |
134 | need_comma = 0; | |
135 | } | |
136 | ||
137 | rep1 = i + 1; | |
138 | reps = 1; | |
139 | while (rep1 < length && string[rep1] == string[i]) | |
140 | { | |
141 | ++rep1; | |
142 | ++reps; | |
143 | } | |
144 | ||
145 | if (reps > repeat_count_threshold) | |
146 | { | |
147 | if (in_quotes) | |
148 | { | |
149 | if (inspect_it) | |
150 | fputs_filtered ("\\\", ", stream); | |
151 | else | |
152 | fputs_filtered ("\", ", stream); | |
153 | in_quotes = 0; | |
154 | } | |
155 | m2_printchar (string[i], stream); | |
156 | fprintf_filtered (stream, " <repeats %u times>", reps); | |
157 | i = rep1 - 1; | |
158 | things_printed += repeat_count_threshold; | |
159 | need_comma = 1; | |
160 | } | |
161 | else | |
162 | { | |
163 | if (!in_quotes) | |
164 | { | |
165 | if (inspect_it) | |
166 | fputs_filtered ("\\\"", stream); | |
167 | else | |
168 | fputs_filtered ("\"", stream); | |
169 | in_quotes = 1; | |
170 | } | |
171 | LA_EMIT_CHAR (string[i], stream, '"'); | |
172 | ++things_printed; | |
173 | } | |
174 | } | |
175 | ||
176 | /* Terminate the quotes if necessary. */ | |
177 | if (in_quotes) | |
178 | { | |
179 | if (inspect_it) | |
180 | fputs_filtered ("\\\"", stream); | |
181 | else | |
182 | fputs_filtered ("\"", stream); | |
183 | } | |
184 | ||
185 | if (force_ellipses || i < length) | |
186 | fputs_filtered ("...", stream); | |
187 | } | |
188 | ||
844781a1 GM |
189 | static struct value * |
190 | evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp, | |
191 | int *pos, enum noside noside) | |
192 | { | |
193 | enum exp_opcode op = exp->elts[*pos].opcode; | |
194 | struct value *arg1; | |
195 | struct value *arg2; | |
196 | struct type *type; | |
197 | switch (op) | |
198 | { | |
199 | case UNOP_HIGH: | |
200 | (*pos)++; | |
201 | arg1 = evaluate_subexp_with_coercion (exp, pos, noside); | |
202 | ||
203 | if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS) | |
204 | return arg1; | |
205 | else | |
206 | { | |
207 | arg1 = coerce_ref (arg1); | |
208 | type = check_typedef (value_type (arg1)); | |
209 | ||
210 | if (m2_is_unbounded_array (type)) | |
211 | { | |
212 | struct value *temp = arg1; | |
213 | type = TYPE_FIELD_TYPE (type, 1); | |
214 | /* i18n: Do not translate the "_m2_high" part! */ | |
215 | arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL, | |
216 | _("unbounded structure " | |
217 | "missing _m2_high field")); | |
218 | ||
219 | if (value_type (arg1) != type) | |
220 | arg1 = value_cast (type, arg1); | |
221 | } | |
222 | } | |
223 | return arg1; | |
224 | ||
225 | case BINOP_SUBSCRIPT: | |
226 | (*pos)++; | |
227 | arg1 = evaluate_subexp_with_coercion (exp, pos, noside); | |
228 | arg2 = evaluate_subexp_with_coercion (exp, pos, noside); | |
229 | if (noside == EVAL_SKIP) | |
230 | goto nosideret; | |
231 | /* If the user attempts to subscript something that is not an | |
232 | array or pointer type (like a plain int variable for example), | |
233 | then report this as an error. */ | |
234 | ||
235 | arg1 = coerce_ref (arg1); | |
236 | type = check_typedef (value_type (arg1)); | |
237 | ||
238 | if (m2_is_unbounded_array (type)) | |
239 | { | |
240 | struct value *temp = arg1; | |
241 | type = TYPE_FIELD_TYPE (type, 0); | |
242 | if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR)) { | |
243 | warning (_("internal error: unbounded array structure is unknown")); | |
244 | return evaluate_subexp_standard (expect_type, exp, pos, noside); | |
245 | } | |
246 | /* i18n: Do not translate the "_m2_contents" part! */ | |
247 | arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL, | |
248 | _("unbounded structure " | |
249 | "missing _m2_contents field")); | |
250 | ||
251 | if (value_type (arg1) != type) | |
252 | arg1 = value_cast (type, arg1); | |
253 | ||
254 | type = check_typedef (value_type (arg1)); | |
255 | return value_ind (value_add (arg1, arg2)); | |
256 | } | |
257 | else | |
258 | if (TYPE_CODE (type) != TYPE_CODE_ARRAY) | |
259 | { | |
260 | if (TYPE_NAME (type)) | |
261 | error (_("cannot subscript something of type `%s'"), | |
262 | TYPE_NAME (type)); | |
263 | else | |
264 | error (_("cannot subscript requested type")); | |
265 | } | |
266 | ||
267 | if (noside == EVAL_AVOID_SIDE_EFFECTS) | |
268 | return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1)); | |
269 | else | |
270 | return value_subscript (arg1, arg2); | |
271 | ||
272 | default: | |
273 | return evaluate_subexp_standard (expect_type, exp, pos, noside); | |
274 | } | |
275 | ||
276 | nosideret: | |
277 | return value_from_longest (builtin_type_long, (LONGEST) 1); | |
278 | } | |
279 | ||
c906108c SS |
280 | /* FIXME: This is a copy of c_create_fundamental_type(), before |
281 | all the non-C types were stripped from it. Needs to be fixed | |
844781a1 | 282 | by an experienced Modula programmer. */ |
c906108c SS |
283 | |
284 | static struct type * | |
fba45db2 | 285 | m2_create_fundamental_type (struct objfile *objfile, int typeid) |
c906108c | 286 | { |
f86f5ca3 | 287 | struct type *type = NULL; |
c906108c SS |
288 | |
289 | switch (typeid) | |
290 | { | |
c5aa993b JM |
291 | default: |
292 | /* FIXME: For now, if we are asked to produce a type not in this | |
293 | language, create the equivalent of a C integer type with the | |
294 | name "<?type?>". When all the dust settles from the type | |
844781a1 | 295 | reconstruction work, this should probably become an error. */ |
c5aa993b | 296 | type = init_type (TYPE_CODE_INT, |
9a76efb6 | 297 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b | 298 | 0, "<?type?>", objfile); |
8a3fe4f8 | 299 | warning (_("internal error: no Modula fundamental type %d"), typeid); |
c5aa993b JM |
300 | break; |
301 | case FT_VOID: | |
302 | type = init_type (TYPE_CODE_VOID, | |
303 | TARGET_CHAR_BIT / TARGET_CHAR_BIT, | |
304 | 0, "void", objfile); | |
305 | break; | |
306 | case FT_BOOLEAN: | |
307 | type = init_type (TYPE_CODE_BOOL, | |
308 | TARGET_CHAR_BIT / TARGET_CHAR_BIT, | |
309 | TYPE_FLAG_UNSIGNED, "boolean", objfile); | |
310 | break; | |
311 | case FT_STRING: | |
312 | type = init_type (TYPE_CODE_STRING, | |
313 | TARGET_CHAR_BIT / TARGET_CHAR_BIT, | |
314 | 0, "string", objfile); | |
315 | break; | |
316 | case FT_CHAR: | |
317 | type = init_type (TYPE_CODE_INT, | |
318 | TARGET_CHAR_BIT / TARGET_CHAR_BIT, | |
319 | 0, "char", objfile); | |
320 | break; | |
321 | case FT_SIGNED_CHAR: | |
322 | type = init_type (TYPE_CODE_INT, | |
323 | TARGET_CHAR_BIT / TARGET_CHAR_BIT, | |
324 | 0, "signed char", objfile); | |
325 | break; | |
326 | case FT_UNSIGNED_CHAR: | |
327 | type = init_type (TYPE_CODE_INT, | |
328 | TARGET_CHAR_BIT / TARGET_CHAR_BIT, | |
329 | TYPE_FLAG_UNSIGNED, "unsigned char", objfile); | |
330 | break; | |
331 | case FT_SHORT: | |
332 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 333 | gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
334 | 0, "short", objfile); |
335 | break; | |
336 | case FT_SIGNED_SHORT: | |
337 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 338 | gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
339 | 0, "short", objfile); /* FIXME-fnf */ |
340 | break; | |
341 | case FT_UNSIGNED_SHORT: | |
342 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 343 | gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
344 | TYPE_FLAG_UNSIGNED, "unsigned short", objfile); |
345 | break; | |
346 | case FT_INTEGER: | |
347 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 348 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
349 | 0, "int", objfile); |
350 | break; | |
351 | case FT_SIGNED_INTEGER: | |
352 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 353 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
354 | 0, "int", objfile); /* FIXME -fnf */ |
355 | break; | |
356 | case FT_UNSIGNED_INTEGER: | |
357 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 358 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
359 | TYPE_FLAG_UNSIGNED, "unsigned int", objfile); |
360 | break; | |
361 | case FT_FIXED_DECIMAL: | |
362 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 363 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
364 | 0, "fixed decimal", objfile); |
365 | break; | |
366 | case FT_LONG: | |
367 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 368 | gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
369 | 0, "long", objfile); |
370 | break; | |
371 | case FT_SIGNED_LONG: | |
372 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 373 | gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
374 | 0, "long", objfile); /* FIXME -fnf */ |
375 | break; | |
376 | case FT_UNSIGNED_LONG: | |
377 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 | 378 | gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
379 | TYPE_FLAG_UNSIGNED, "unsigned long", objfile); |
380 | break; | |
381 | case FT_LONG_LONG: | |
382 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 UW |
383 | gdbarch_long_long_bit (current_gdbarch) |
384 | / TARGET_CHAR_BIT, | |
c5aa993b JM |
385 | 0, "long long", objfile); |
386 | break; | |
387 | case FT_SIGNED_LONG_LONG: | |
388 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 UW |
389 | gdbarch_long_long_bit (current_gdbarch) |
390 | / TARGET_CHAR_BIT, | |
c5aa993b JM |
391 | 0, "signed long long", objfile); |
392 | break; | |
393 | case FT_UNSIGNED_LONG_LONG: | |
394 | type = init_type (TYPE_CODE_INT, | |
9a76efb6 UW |
395 | gdbarch_long_long_bit (current_gdbarch) |
396 | / TARGET_CHAR_BIT, | |
c5aa993b JM |
397 | TYPE_FLAG_UNSIGNED, "unsigned long long", objfile); |
398 | break; | |
399 | case FT_FLOAT: | |
400 | type = init_type (TYPE_CODE_FLT, | |
ea06eb3d | 401 | gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
402 | 0, "float", objfile); |
403 | break; | |
404 | case FT_DBL_PREC_FLOAT: | |
405 | type = init_type (TYPE_CODE_FLT, | |
ea06eb3d | 406 | gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
407 | 0, "double", objfile); |
408 | break; | |
409 | case FT_FLOAT_DECIMAL: | |
410 | type = init_type (TYPE_CODE_FLT, | |
ea06eb3d | 411 | gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT, |
c5aa993b JM |
412 | 0, "floating decimal", objfile); |
413 | break; | |
414 | case FT_EXT_PREC_FLOAT: | |
415 | type = init_type (TYPE_CODE_FLT, | |
ea06eb3d UW |
416 | gdbarch_long_double_bit (current_gdbarch) |
417 | / TARGET_CHAR_BIT, | |
c5aa993b JM |
418 | 0, "long double", objfile); |
419 | break; | |
420 | case FT_COMPLEX: | |
421 | type = init_type (TYPE_CODE_COMPLEX, | |
ea06eb3d UW |
422 | 2 * gdbarch_float_bit (current_gdbarch) |
423 | / TARGET_CHAR_BIT, | |
c5aa993b JM |
424 | 0, "complex", objfile); |
425 | TYPE_TARGET_TYPE (type) | |
426 | = m2_create_fundamental_type (objfile, FT_FLOAT); | |
427 | break; | |
428 | case FT_DBL_PREC_COMPLEX: | |
429 | type = init_type (TYPE_CODE_COMPLEX, | |
ea06eb3d UW |
430 | 2 * gdbarch_double_bit (current_gdbarch) |
431 | / TARGET_CHAR_BIT, | |
c5aa993b JM |
432 | 0, "double complex", objfile); |
433 | TYPE_TARGET_TYPE (type) | |
434 | = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT); | |
435 | break; | |
436 | case FT_EXT_PREC_COMPLEX: | |
437 | type = init_type (TYPE_CODE_COMPLEX, | |
ea06eb3d UW |
438 | 2 * gdbarch_long_double_bit (current_gdbarch) |
439 | / TARGET_CHAR_BIT, | |
c5aa993b JM |
440 | 0, "long double complex", objfile); |
441 | TYPE_TARGET_TYPE (type) | |
442 | = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT); | |
443 | break; | |
444 | } | |
c906108c SS |
445 | return (type); |
446 | } | |
c906108c | 447 | \f |
c5aa993b | 448 | |
c906108c SS |
449 | /* Table of operators and their precedences for printing expressions. */ |
450 | ||
c5aa993b JM |
451 | static const struct op_print m2_op_print_tab[] = |
452 | { | |
453 | {"+", BINOP_ADD, PREC_ADD, 0}, | |
454 | {"+", UNOP_PLUS, PREC_PREFIX, 0}, | |
455 | {"-", BINOP_SUB, PREC_ADD, 0}, | |
456 | {"-", UNOP_NEG, PREC_PREFIX, 0}, | |
457 | {"*", BINOP_MUL, PREC_MUL, 0}, | |
458 | {"/", BINOP_DIV, PREC_MUL, 0}, | |
459 | {"DIV", BINOP_INTDIV, PREC_MUL, 0}, | |
460 | {"MOD", BINOP_REM, PREC_MUL, 0}, | |
461 | {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, | |
462 | {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0}, | |
463 | {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0}, | |
464 | {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, | |
465 | {"=", BINOP_EQUAL, PREC_EQUAL, 0}, | |
466 | {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0}, | |
467 | {"<=", BINOP_LEQ, PREC_ORDER, 0}, | |
468 | {">=", BINOP_GEQ, PREC_ORDER, 0}, | |
469 | {">", BINOP_GTR, PREC_ORDER, 0}, | |
470 | {"<", BINOP_LESS, PREC_ORDER, 0}, | |
471 | {"^", UNOP_IND, PREC_PREFIX, 0}, | |
472 | {"@", BINOP_REPEAT, PREC_REPEAT, 0}, | |
473 | {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0}, | |
474 | {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0}, | |
475 | {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0}, | |
476 | {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0}, | |
477 | {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0}, | |
478 | {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0}, | |
479 | {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0}, | |
480 | {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0}, | |
481 | {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0}, | |
482 | {NULL, 0, 0, 0} | |
c906108c SS |
483 | }; |
484 | \f | |
485 | /* The built-in types of Modula-2. */ | |
486 | ||
cad351d1 UW |
487 | enum m2_primitive_types { |
488 | m2_primitive_type_char, | |
489 | m2_primitive_type_int, | |
490 | m2_primitive_type_card, | |
491 | m2_primitive_type_real, | |
492 | m2_primitive_type_bool, | |
493 | nr_m2_primitive_types | |
c906108c SS |
494 | }; |
495 | ||
cad351d1 UW |
496 | static void |
497 | m2_language_arch_info (struct gdbarch *gdbarch, | |
498 | struct language_arch_info *lai) | |
499 | { | |
5760b90a UW |
500 | const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch); |
501 | ||
502 | lai->string_char_type = builtin->builtin_char; | |
cad351d1 UW |
503 | lai->primitive_type_vector |
504 | = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1, | |
505 | struct type *); | |
506 | ||
507 | lai->primitive_type_vector [m2_primitive_type_char] | |
5760b90a | 508 | = builtin->builtin_char; |
cad351d1 | 509 | lai->primitive_type_vector [m2_primitive_type_int] |
5760b90a | 510 | = builtin->builtin_int; |
cad351d1 | 511 | lai->primitive_type_vector [m2_primitive_type_card] |
5760b90a | 512 | = builtin->builtin_card; |
cad351d1 | 513 | lai->primitive_type_vector [m2_primitive_type_real] |
5760b90a | 514 | = builtin->builtin_real; |
cad351d1 | 515 | lai->primitive_type_vector [m2_primitive_type_bool] |
5760b90a | 516 | = builtin->builtin_bool; |
cad351d1 UW |
517 | } |
518 | ||
844781a1 GM |
519 | const struct exp_descriptor exp_descriptor_modula2 = |
520 | { | |
521 | print_subexp_standard, | |
522 | operator_length_standard, | |
523 | op_name_standard, | |
524 | dump_subexp_body_standard, | |
525 | evaluate_subexp_modula2 | |
526 | }; | |
527 | ||
c5aa993b JM |
528 | const struct language_defn m2_language_defn = |
529 | { | |
c906108c SS |
530 | "modula-2", |
531 | language_m2, | |
c906108c SS |
532 | range_check_on, |
533 | type_check_on, | |
63872f9d | 534 | case_sensitive_on, |
7ca2d3a3 | 535 | array_row_major, |
844781a1 | 536 | &exp_descriptor_modula2, |
c906108c SS |
537 | m2_parse, /* parser */ |
538 | m2_error, /* parser error function */ | |
e85c3284 | 539 | null_post_parser, |
c906108c SS |
540 | m2_printchar, /* Print character constant */ |
541 | m2_printstr, /* function to print string constant */ | |
542 | m2_emit_char, /* Function to print a single character */ | |
543 | m2_create_fundamental_type, /* Create fundamental type in this language */ | |
544 | m2_print_type, /* Print a type using appropriate syntax */ | |
545 | m2_val_print, /* Print a value using appropriate syntax */ | |
546 | c_value_print, /* Print a top-level value */ | |
f636b87d | 547 | NULL, /* Language specific skip_trampoline */ |
5f9a71c3 DC |
548 | value_of_this, /* value_of_this */ |
549 | basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */ | |
b368761e | 550 | basic_lookup_transparent_type,/* lookup_transparent_type */ |
9a3d7dfd | 551 | NULL, /* Language specific symbol demangler */ |
31c27f77 | 552 | NULL, /* Language specific class_name_from_physname */ |
c906108c SS |
553 | m2_op_print_tab, /* expression operators for printing */ |
554 | 0, /* arrays are first-class (not c-style) */ | |
555 | 0, /* String lower bound */ | |
6084f43a | 556 | default_word_break_characters, |
cad351d1 | 557 | m2_language_arch_info, |
e79af960 | 558 | default_print_array_index, |
41f1b697 | 559 | default_pass_by_reference, |
c906108c SS |
560 | LANG_MAGIC |
561 | }; | |
562 | ||
5760b90a UW |
563 | static void * |
564 | build_m2_types (struct gdbarch *gdbarch) | |
c906108c | 565 | { |
5760b90a UW |
566 | struct builtin_m2_type *builtin_m2_type |
567 | = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type); | |
568 | ||
c906108c | 569 | /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */ |
5760b90a | 570 | builtin_m2_type->builtin_int = |
9a76efb6 UW |
571 | init_type (TYPE_CODE_INT, |
572 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, | |
573 | 0, "INTEGER", (struct objfile *) NULL); | |
5760b90a | 574 | builtin_m2_type->builtin_card = |
9a76efb6 UW |
575 | init_type (TYPE_CODE_INT, |
576 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, | |
c906108c SS |
577 | TYPE_FLAG_UNSIGNED, |
578 | "CARDINAL", (struct objfile *) NULL); | |
5760b90a | 579 | builtin_m2_type->builtin_real = |
ea06eb3d UW |
580 | init_type (TYPE_CODE_FLT, |
581 | gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT, | |
c906108c SS |
582 | 0, |
583 | "REAL", (struct objfile *) NULL); | |
5760b90a | 584 | builtin_m2_type->builtin_char = |
c906108c SS |
585 | init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT, |
586 | TYPE_FLAG_UNSIGNED, | |
587 | "CHAR", (struct objfile *) NULL); | |
5760b90a | 588 | builtin_m2_type->builtin_bool = |
9a76efb6 UW |
589 | init_type (TYPE_CODE_BOOL, |
590 | gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, | |
c906108c SS |
591 | TYPE_FLAG_UNSIGNED, |
592 | "BOOLEAN", (struct objfile *) NULL); | |
593 | ||
5760b90a UW |
594 | return builtin_m2_type; |
595 | } | |
596 | ||
597 | static struct gdbarch_data *m2_type_data; | |
598 | ||
599 | const struct builtin_m2_type * | |
600 | builtin_m2_type (struct gdbarch *gdbarch) | |
601 | { | |
602 | return gdbarch_data (gdbarch, m2_type_data); | |
603 | } | |
604 | ||
605 | ||
606 | /* Initialization for Modula-2 */ | |
607 | ||
608 | void | |
609 | _initialize_m2_language (void) | |
610 | { | |
611 | m2_type_data = gdbarch_data_register_post_init (build_m2_types); | |
612 | ||
c906108c SS |
613 | add_language (&m2_language_defn); |
614 | } |