1 /* Modula 2 language support routines for GDB, the GNU debugger.
2 Copyright 1992 Free Software Foundation, Inc.
4 This file is part of GDB.
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.
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.
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., 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include "expression.h"
24 #include "parser-defs.h"
28 /* Print the character C on STREAM as part of the contents of a literal
29 string whose delimiter is QUOTER. Note that that format for printing
30 characters and strings is language specific.
31 FIXME: This is a copy of the same function from c-exp.y. It should
32 be replaced with a true Modula version.
36 emit_char (c, stream, quoter)
42 c &= 0xFF; /* Avoid sign bit follies */
44 if (PRINT_LITERAL_FORM (c))
46 if (c == '\\' || c == quoter)
48 fputs_filtered ("\\", stream);
50 fprintf_filtered (stream, "%c", c);
57 fputs_filtered ("\\n", stream);
60 fputs_filtered ("\\b", stream);
63 fputs_filtered ("\\t", stream);
66 fputs_filtered ("\\f", stream);
69 fputs_filtered ("\\r", stream);
72 fputs_filtered ("\\e", stream);
75 fputs_filtered ("\\a", stream);
78 fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
84 /* FIXME: This is a copy of the same function from c-exp.y. It should
85 be replaced with a true Modula version. */
88 m2_printchar (c, stream)
92 fputs_filtered ("'", stream);
93 emit_char (c, stream, '\'');
94 fputs_filtered ("'", stream);
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 FIXME: This is a copy of the same function from c-exp.y. It should
102 be replaced with a true Modula version. */
105 m2_printstr (stream, string, length, force_ellipses)
111 register unsigned int i;
112 unsigned int things_printed = 0;
115 extern int inspect_it;
116 extern int repeat_count_threshold;
117 extern int print_max;
121 fputs_filtered ("\"\"", stdout);
125 for (i = 0; i < length && things_printed < print_max; ++i)
127 /* Position of the character we are examining
128 to see whether it is repeated. */
130 /* Number of repetitions we have detected so far. */
137 fputs_filtered (", ", stream);
143 while (rep1 < length && string[rep1] == string[i])
149 if (reps > repeat_count_threshold)
154 fputs_filtered ("\\\", ", stream);
156 fputs_filtered ("\", ", stream);
159 m2_printchar (string[i], stream);
160 fprintf_filtered (stream, " <repeats %u times>", reps);
162 things_printed += repeat_count_threshold;
170 fputs_filtered ("\\\"", stream);
172 fputs_filtered ("\"", stream);
175 emit_char (string[i], stream, '"');
180 /* Terminate the quotes if necessary. */
184 fputs_filtered ("\\\"", stream);
186 fputs_filtered ("\"", stream);
189 if (force_ellipses || i < length)
190 fputs_filtered ("...", stream);
193 /* FIXME: This is a copy of c_create_fundamental_type(), before
194 all the non-C types were stripped from it. Needs to be fixed
195 by an experienced Modula programmer. */
198 m2_create_fundamental_type (objfile, typeid)
199 struct objfile *objfile;
202 register struct type *type = NULL;
208 /* FIXME: For now, if we are asked to produce a type not in this
209 language, create the equivalent of a C integer type with the
210 name "<?type?>". When all the dust settles from the type
211 reconstruction work, this should probably become an error. */
212 type = init_type (TYPE_CODE_INT,
213 TARGET_INT_BIT / TARGET_CHAR_BIT,
214 0, "<?type?>", objfile);
215 warning ("internal error: no Modula fundamental type %d", typeid);
218 type = init_type (TYPE_CODE_VOID,
219 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
223 type = init_type (TYPE_CODE_BOOL,
224 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
225 TYPE_FLAG_UNSIGNED, "boolean", objfile);
228 type = init_type (TYPE_CODE_PASCAL_ARRAY,
229 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
230 0, "string", objfile);
233 type = init_type (TYPE_CODE_INT,
234 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
238 type = init_type (TYPE_CODE_INT,
239 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
240 TYPE_FLAG_SIGNED, "signed char", objfile);
242 case FT_UNSIGNED_CHAR:
243 type = init_type (TYPE_CODE_INT,
244 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
245 TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
248 type = init_type (TYPE_CODE_INT,
249 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
250 0, "short", objfile);
252 case FT_SIGNED_SHORT:
253 type = init_type (TYPE_CODE_INT,
254 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
255 TYPE_FLAG_SIGNED, "short", objfile); /* FIXME-fnf */
257 case FT_UNSIGNED_SHORT:
258 type = init_type (TYPE_CODE_INT,
259 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
260 TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
263 type = init_type (TYPE_CODE_INT,
264 TARGET_INT_BIT / TARGET_CHAR_BIT,
267 case FT_SIGNED_INTEGER:
268 type = init_type (TYPE_CODE_INT,
269 TARGET_INT_BIT / TARGET_CHAR_BIT,
270 TYPE_FLAG_SIGNED, "int", objfile); /* FIXME -fnf */
272 case FT_UNSIGNED_INTEGER:
273 type = init_type (TYPE_CODE_INT,
274 TARGET_INT_BIT / TARGET_CHAR_BIT,
275 TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
277 case FT_FIXED_DECIMAL:
278 type = init_type (TYPE_CODE_INT,
279 TARGET_INT_BIT / TARGET_CHAR_BIT,
280 0, "fixed decimal", objfile);
283 type = init_type (TYPE_CODE_INT,
284 TARGET_LONG_BIT / TARGET_CHAR_BIT,
288 type = init_type (TYPE_CODE_INT,
289 TARGET_LONG_BIT / TARGET_CHAR_BIT,
290 TYPE_FLAG_SIGNED, "long", objfile); /* FIXME -fnf */
292 case FT_UNSIGNED_LONG:
293 type = init_type (TYPE_CODE_INT,
294 TARGET_LONG_BIT / TARGET_CHAR_BIT,
295 TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
298 type = init_type (TYPE_CODE_INT,
299 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
300 0, "long long", objfile);
302 case FT_SIGNED_LONG_LONG:
303 type = init_type (TYPE_CODE_INT,
304 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
305 TYPE_FLAG_SIGNED, "signed long long", objfile);
307 case FT_UNSIGNED_LONG_LONG:
308 type = init_type (TYPE_CODE_INT,
309 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
310 TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
313 type = init_type (TYPE_CODE_FLT,
314 TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
315 0, "float", objfile);
317 case FT_DBL_PREC_FLOAT:
318 type = init_type (TYPE_CODE_FLT,
319 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
320 0, "double", objfile);
322 case FT_FLOAT_DECIMAL:
323 type = init_type (TYPE_CODE_FLT,
324 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
325 0, "floating decimal", objfile);
327 case FT_EXT_PREC_FLOAT:
328 type = init_type (TYPE_CODE_FLT,
329 TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
330 0, "long double", objfile);
333 type = init_type (TYPE_CODE_FLT,
334 TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
335 0, "complex", objfile);
337 case FT_DBL_PREC_COMPLEX:
338 type = init_type (TYPE_CODE_FLT,
339 TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
340 0, "double complex", objfile);
342 case FT_EXT_PREC_COMPLEX:
343 type = init_type (TYPE_CODE_FLT,
344 TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
345 0, "long double complex", objfile);
352 /* Table of operators and their precedences for printing expressions. */
354 const static struct op_print m2_op_print_tab[] = {
355 {"+", BINOP_ADD, PREC_ADD, 0},
356 {"+", UNOP_PLUS, PREC_PREFIX, 0},
357 {"-", BINOP_SUB, PREC_ADD, 0},
358 {"-", UNOP_NEG, PREC_PREFIX, 0},
359 {"*", BINOP_MUL, PREC_MUL, 0},
360 {"/", BINOP_DIV, PREC_MUL, 0},
361 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
362 {"MOD", BINOP_REM, PREC_MUL, 0},
363 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
364 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
365 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
366 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
367 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
368 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
369 {"<=", BINOP_LEQ, PREC_ORDER, 0},
370 {">=", BINOP_GEQ, PREC_ORDER, 0},
371 {">", BINOP_GTR, PREC_ORDER, 0},
372 {"<", BINOP_LESS, PREC_ORDER, 0},
373 {"^", UNOP_IND, PREC_PREFIX, 0},
374 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
378 /* The built-in types of Modula-2. */
380 struct type *builtin_type_m2_char;
381 struct type *builtin_type_m2_int;
382 struct type *builtin_type_m2_card;
383 struct type *builtin_type_m2_real;
384 struct type *builtin_type_m2_bool;
386 struct type ** const (m2_builtin_types[]) =
388 &builtin_type_m2_char,
389 &builtin_type_m2_int,
390 &builtin_type_m2_card,
391 &builtin_type_m2_real,
392 &builtin_type_m2_bool,
396 const struct language_defn m2_language_defn = {
402 m2_parse, /* parser */
403 m2_error, /* parser error function */
404 m2_printchar, /* Print character constant */
405 m2_printstr, /* function to print string constant */
406 m2_create_fundamental_type, /* Create fundamental type in this language */
407 &builtin_type_m2_int, /* longest signed integral type */
408 &builtin_type_m2_card, /* longest unsigned integral type */
409 &builtin_type_m2_real, /* longest floating point type */
410 {"", "", "", ""}, /* Binary format info */
411 {"%oB", "", "o", "B"}, /* Octal format info */
412 {"%d", "", "d", ""}, /* Decimal format info */
413 {"0%XH", "0", "X", "H"}, /* Hex format info */
414 m2_op_print_tab, /* expression operators for printing */
418 /* Initialization for Modula-2 */
421 _initialize_m2_language ()
423 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
424 builtin_type_m2_int =
425 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
427 "INTEGER", (struct objfile *) NULL);
428 builtin_type_m2_card =
429 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
431 "CARDINAL", (struct objfile *) NULL);
432 builtin_type_m2_real =
433 init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
435 "REAL", (struct objfile *) NULL);
436 builtin_type_m2_char =
437 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
439 "CHAR", (struct objfile *) NULL);
440 builtin_type_m2_bool =
441 init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
443 "BOOLEAN", (struct objfile *) NULL);
445 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
446 TYPE_FIELDS(builtin_type_m2_bool) =
447 (struct field *) xmalloc (sizeof (struct field) * 2);
448 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
449 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)xmalloc(6);
450 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
451 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
452 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)xmalloc(5);
453 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
455 add_language (&m2_language_defn);