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., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
24 #include "expression.h"
25 #include "parser-defs.h"
30 extern void _initialize_m2_language PARAMS ((void));
31 static struct type *m2_create_fundamental_type PARAMS ((struct objfile *, int));
32 static void m2_printstr PARAMS ((GDB_FILE * stream, char *string, unsigned int length, int width, int force_ellipses));
33 static void m2_printchar PARAMS ((int, GDB_FILE *));
34 static void m2_emit_char PARAMS ((int, GDB_FILE *, int));
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
40 be replaced with a true Modula version.
44 m2_emit_char (c, stream, quoter)
50 c &= 0xFF; /* Avoid sign bit follies */
52 if (PRINT_LITERAL_FORM (c))
54 if (c == '\\' || c == quoter)
56 fputs_filtered ("\\", stream);
58 fprintf_filtered (stream, "%c", c);
65 fputs_filtered ("\\n", stream);
68 fputs_filtered ("\\b", stream);
71 fputs_filtered ("\\t", stream);
74 fputs_filtered ("\\f", stream);
77 fputs_filtered ("\\r", stream);
80 fputs_filtered ("\\e", stream);
83 fputs_filtered ("\\a", stream);
86 fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
92 /* FIXME: This is a copy of the same function from c-exp.y. It should
93 be replaced with a true Modula version. */
96 m2_printchar (c, stream)
100 fputs_filtered ("'", stream);
101 LA_EMIT_CHAR (c, stream, '\'');
102 fputs_filtered ("'", stream);
105 /* Print the character string STRING, printing at most LENGTH characters.
106 Printing stops early if the number hits print_max; repeat counts
107 are printed as appropriate. Print ellipses at the end if we
108 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
109 FIXME: This is a copy of the same function from c-exp.y. It should
110 be replaced with a true Modula version. */
113 m2_printstr (stream, string, length, width, force_ellipses)
120 register unsigned int i;
121 unsigned int things_printed = 0;
124 extern int inspect_it;
125 extern int repeat_count_threshold;
126 extern int print_max;
130 fputs_filtered ("\"\"", gdb_stdout);
134 for (i = 0; i < length && things_printed < print_max; ++i)
136 /* Position of the character we are examining
137 to see whether it is repeated. */
139 /* Number of repetitions we have detected so far. */
146 fputs_filtered (", ", stream);
152 while (rep1 < length && string[rep1] == string[i])
158 if (reps > repeat_count_threshold)
163 fputs_filtered ("\\\", ", stream);
165 fputs_filtered ("\", ", stream);
168 m2_printchar (string[i], stream);
169 fprintf_filtered (stream, " <repeats %u times>", reps);
171 things_printed += repeat_count_threshold;
179 fputs_filtered ("\\\"", stream);
181 fputs_filtered ("\"", stream);
184 LA_EMIT_CHAR (string[i], stream, '"');
189 /* Terminate the quotes if necessary. */
193 fputs_filtered ("\\\"", stream);
195 fputs_filtered ("\"", stream);
198 if (force_ellipses || i < length)
199 fputs_filtered ("...", stream);
202 /* FIXME: This is a copy of c_create_fundamental_type(), before
203 all the non-C types were stripped from it. Needs to be fixed
204 by an experienced Modula programmer. */
207 m2_create_fundamental_type (objfile, typeid)
208 struct objfile *objfile;
211 register struct type *type = NULL;
216 /* FIXME: For now, if we are asked to produce a type not in this
217 language, create the equivalent of a C integer type with the
218 name "<?type?>". When all the dust settles from the type
219 reconstruction work, this should probably become an error. */
220 type = init_type (TYPE_CODE_INT,
221 TARGET_INT_BIT / TARGET_CHAR_BIT,
222 0, "<?type?>", objfile);
223 warning ("internal error: no Modula fundamental type %d", typeid);
226 type = init_type (TYPE_CODE_VOID,
227 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
231 type = init_type (TYPE_CODE_BOOL,
232 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
233 TYPE_FLAG_UNSIGNED, "boolean", objfile);
236 type = init_type (TYPE_CODE_STRING,
237 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
238 0, "string", objfile);
241 type = init_type (TYPE_CODE_INT,
242 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
246 type = init_type (TYPE_CODE_INT,
247 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
248 0, "signed char", objfile);
250 case FT_UNSIGNED_CHAR:
251 type = init_type (TYPE_CODE_INT,
252 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
253 TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
256 type = init_type (TYPE_CODE_INT,
257 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
258 0, "short", objfile);
260 case FT_SIGNED_SHORT:
261 type = init_type (TYPE_CODE_INT,
262 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
263 0, "short", objfile); /* FIXME-fnf */
265 case FT_UNSIGNED_SHORT:
266 type = init_type (TYPE_CODE_INT,
267 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
268 TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
271 type = init_type (TYPE_CODE_INT,
272 TARGET_INT_BIT / TARGET_CHAR_BIT,
275 case FT_SIGNED_INTEGER:
276 type = init_type (TYPE_CODE_INT,
277 TARGET_INT_BIT / TARGET_CHAR_BIT,
278 0, "int", objfile); /* FIXME -fnf */
280 case FT_UNSIGNED_INTEGER:
281 type = init_type (TYPE_CODE_INT,
282 TARGET_INT_BIT / TARGET_CHAR_BIT,
283 TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
285 case FT_FIXED_DECIMAL:
286 type = init_type (TYPE_CODE_INT,
287 TARGET_INT_BIT / TARGET_CHAR_BIT,
288 0, "fixed decimal", objfile);
291 type = init_type (TYPE_CODE_INT,
292 TARGET_LONG_BIT / TARGET_CHAR_BIT,
296 type = init_type (TYPE_CODE_INT,
297 TARGET_LONG_BIT / TARGET_CHAR_BIT,
298 0, "long", objfile); /* FIXME -fnf */
300 case FT_UNSIGNED_LONG:
301 type = init_type (TYPE_CODE_INT,
302 TARGET_LONG_BIT / TARGET_CHAR_BIT,
303 TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
306 type = init_type (TYPE_CODE_INT,
307 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
308 0, "long long", objfile);
310 case FT_SIGNED_LONG_LONG:
311 type = init_type (TYPE_CODE_INT,
312 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
313 0, "signed long long", objfile);
315 case FT_UNSIGNED_LONG_LONG:
316 type = init_type (TYPE_CODE_INT,
317 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
318 TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
321 type = init_type (TYPE_CODE_FLT,
322 TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
323 0, "float", objfile);
325 case FT_DBL_PREC_FLOAT:
326 type = init_type (TYPE_CODE_FLT,
327 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
328 0, "double", objfile);
330 case FT_FLOAT_DECIMAL:
331 type = init_type (TYPE_CODE_FLT,
332 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
333 0, "floating decimal", objfile);
335 case FT_EXT_PREC_FLOAT:
336 type = init_type (TYPE_CODE_FLT,
337 TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
338 0, "long double", objfile);
341 type = init_type (TYPE_CODE_COMPLEX,
342 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
343 0, "complex", objfile);
344 TYPE_TARGET_TYPE (type)
345 = m2_create_fundamental_type (objfile, FT_FLOAT);
347 case FT_DBL_PREC_COMPLEX:
348 type = init_type (TYPE_CODE_COMPLEX,
349 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
350 0, "double complex", objfile);
351 TYPE_TARGET_TYPE (type)
352 = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
354 case FT_EXT_PREC_COMPLEX:
355 type = init_type (TYPE_CODE_COMPLEX,
356 2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
357 0, "long double complex", objfile);
358 TYPE_TARGET_TYPE (type)
359 = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
366 /* Table of operators and their precedences for printing expressions. */
368 static const struct op_print m2_op_print_tab[] =
370 {"+", BINOP_ADD, PREC_ADD, 0},
371 {"+", UNOP_PLUS, PREC_PREFIX, 0},
372 {"-", BINOP_SUB, PREC_ADD, 0},
373 {"-", UNOP_NEG, PREC_PREFIX, 0},
374 {"*", BINOP_MUL, PREC_MUL, 0},
375 {"/", BINOP_DIV, PREC_MUL, 0},
376 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
377 {"MOD", BINOP_REM, PREC_MUL, 0},
378 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
379 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
380 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
381 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
382 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
383 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
384 {"<=", BINOP_LEQ, PREC_ORDER, 0},
385 {">=", BINOP_GEQ, PREC_ORDER, 0},
386 {">", BINOP_GTR, PREC_ORDER, 0},
387 {"<", BINOP_LESS, PREC_ORDER, 0},
388 {"^", UNOP_IND, PREC_PREFIX, 0},
389 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
390 {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
391 {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
392 {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
393 {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
394 {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
395 {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
396 {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
397 {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
398 {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
402 /* The built-in types of Modula-2. */
404 struct type *builtin_type_m2_char;
405 struct type *builtin_type_m2_int;
406 struct type *builtin_type_m2_card;
407 struct type *builtin_type_m2_real;
408 struct type *builtin_type_m2_bool;
410 struct type **CONST_PTR (m2_builtin_types[]) =
412 &builtin_type_m2_char,
413 &builtin_type_m2_int,
414 &builtin_type_m2_card,
415 &builtin_type_m2_real,
416 &builtin_type_m2_bool,
420 const struct language_defn m2_language_defn =
427 m2_parse, /* parser */
428 m2_error, /* parser error function */
429 evaluate_subexp_standard,
430 m2_printchar, /* Print character constant */
431 m2_printstr, /* function to print string constant */
432 m2_emit_char, /* Function to print a single character */
433 m2_create_fundamental_type, /* Create fundamental type in this language */
434 m2_print_type, /* Print a type using appropriate syntax */
435 m2_val_print, /* Print a value using appropriate syntax */
436 c_value_print, /* Print a top-level value */
437 {"", "", "", ""}, /* Binary format info */
438 {"%loB", "", "o", "B"}, /* Octal format info */
439 {"%ld", "", "d", ""}, /* Decimal format info */
440 {"0%lXH", "0", "X", "H"}, /* Hex format info */
441 m2_op_print_tab, /* expression operators for printing */
442 0, /* arrays are first-class (not c-style) */
443 0, /* String lower bound */
444 &builtin_type_m2_char, /* Type of string elements */
448 /* Initialization for Modula-2 */
451 _initialize_m2_language ()
453 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
454 builtin_type_m2_int =
455 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
457 "INTEGER", (struct objfile *) NULL);
458 builtin_type_m2_card =
459 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
461 "CARDINAL", (struct objfile *) NULL);
462 builtin_type_m2_real =
463 init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
465 "REAL", (struct objfile *) NULL);
466 builtin_type_m2_char =
467 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
469 "CHAR", (struct objfile *) NULL);
470 builtin_type_m2_bool =
471 init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
473 "BOOLEAN", (struct objfile *) NULL);
475 add_language (&m2_language_defn);