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"
29 /* Print the character C on STREAM as part of the contents of a literal
30 string whose delimiter is QUOTER. Note that that format for printing
31 characters and strings is language specific.
32 FIXME: This is a copy of the same function from c-exp.y. It should
33 be replaced with a true Modula version.
37 emit_char (c
, stream
, quoter
)
43 c
&= 0xFF; /* Avoid sign bit follies */
45 if (PRINT_LITERAL_FORM (c
))
47 if (c
== '\\' || c
== quoter
)
49 fputs_filtered ("\\", stream
);
51 fprintf_filtered (stream
, "%c", c
);
58 fputs_filtered ("\\n", stream
);
61 fputs_filtered ("\\b", stream
);
64 fputs_filtered ("\\t", stream
);
67 fputs_filtered ("\\f", stream
);
70 fputs_filtered ("\\r", stream
);
73 fputs_filtered ("\\e", stream
);
76 fputs_filtered ("\\a", stream
);
79 fprintf_filtered (stream
, "\\%.3o", (unsigned int) c
);
85 /* FIXME: This is a copy of the same function from c-exp.y. It should
86 be replaced with a true Modula version. */
89 m2_printchar (c
, stream
)
93 fputs_filtered ("'", stream
);
94 emit_char (c
, stream
, '\'');
95 fputs_filtered ("'", stream
);
98 /* Print the character string STRING, printing at most LENGTH characters.
99 Printing stops early if the number hits print_max; repeat counts
100 are printed as appropriate. Print ellipses at the end if we
101 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
102 FIXME: This is a copy of the same function from c-exp.y. It should
103 be replaced with a true Modula version. */
106 m2_printstr (stream
, string
, length
, force_ellipses
)
112 register unsigned int i
;
113 unsigned int things_printed
= 0;
116 extern int inspect_it
;
117 extern int repeat_count_threshold
;
118 extern int print_max
;
122 fputs_filtered ("\"\"", gdb_stdout
);
126 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
128 /* Position of the character we are examining
129 to see whether it is repeated. */
131 /* Number of repetitions we have detected so far. */
138 fputs_filtered (", ", stream
);
144 while (rep1
< length
&& string
[rep1
] == string
[i
])
150 if (reps
> repeat_count_threshold
)
155 fputs_filtered ("\\\", ", stream
);
157 fputs_filtered ("\", ", stream
);
160 m2_printchar (string
[i
], stream
);
161 fprintf_filtered (stream
, " <repeats %u times>", reps
);
163 things_printed
+= repeat_count_threshold
;
171 fputs_filtered ("\\\"", stream
);
173 fputs_filtered ("\"", stream
);
176 emit_char (string
[i
], stream
, '"');
181 /* Terminate the quotes if necessary. */
185 fputs_filtered ("\\\"", stream
);
187 fputs_filtered ("\"", stream
);
190 if (force_ellipses
|| i
< length
)
191 fputs_filtered ("...", stream
);
194 /* FIXME: This is a copy of c_create_fundamental_type(), before
195 all the non-C types were stripped from it. Needs to be fixed
196 by an experienced Modula programmer. */
199 m2_create_fundamental_type (objfile
, typeid)
200 struct objfile
*objfile
;
203 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_STRING
,
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 0, "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 0, "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 0, "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 0, "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 0, "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_COMPLEX
,
334 2 * TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
335 0, "complex", objfile
);
336 TYPE_TARGET_TYPE (type
)
337 = m2_create_fundamental_type (objfile
, FT_FLOAT
);
339 case FT_DBL_PREC_COMPLEX
:
340 type
= init_type (TYPE_CODE_COMPLEX
,
341 2 * TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
342 0, "double complex", objfile
);
343 TYPE_TARGET_TYPE (type
)
344 = m2_create_fundamental_type (objfile
, FT_DBL_PREC_FLOAT
);
346 case FT_EXT_PREC_COMPLEX
:
347 type
= init_type (TYPE_CODE_COMPLEX
,
348 2 * TARGET_LONG_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
349 0, "long double complex", objfile
);
350 TYPE_TARGET_TYPE (type
)
351 = m2_create_fundamental_type (objfile
, FT_EXT_PREC_FLOAT
);
358 /* Table of operators and their precedences for printing expressions. */
360 static const struct op_print m2_op_print_tab
[] = {
361 {"+", BINOP_ADD
, PREC_ADD
, 0},
362 {"+", UNOP_PLUS
, PREC_PREFIX
, 0},
363 {"-", BINOP_SUB
, PREC_ADD
, 0},
364 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
365 {"*", BINOP_MUL
, PREC_MUL
, 0},
366 {"/", BINOP_DIV
, PREC_MUL
, 0},
367 {"DIV", BINOP_INTDIV
, PREC_MUL
, 0},
368 {"MOD", BINOP_REM
, PREC_MUL
, 0},
369 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
370 {"OR", BINOP_LOGICAL_OR
, PREC_LOGICAL_OR
, 0},
371 {"AND", BINOP_LOGICAL_AND
, PREC_LOGICAL_AND
, 0},
372 {"NOT", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
373 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
374 {"<>", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
375 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
376 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
377 {">", BINOP_GTR
, PREC_ORDER
, 0},
378 {"<", BINOP_LESS
, PREC_ORDER
, 0},
379 {"^", UNOP_IND
, PREC_PREFIX
, 0},
380 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
381 {"CAP", UNOP_CAP
, PREC_BUILTIN_FUNCTION
, 0},
382 {"CHR", UNOP_CHR
, PREC_BUILTIN_FUNCTION
, 0},
383 {"ORD", UNOP_ORD
, PREC_BUILTIN_FUNCTION
, 0},
384 {"FLOAT",UNOP_FLOAT
, PREC_BUILTIN_FUNCTION
, 0},
385 {"HIGH", UNOP_HIGH
, PREC_BUILTIN_FUNCTION
, 0},
386 {"MAX", UNOP_MAX
, PREC_BUILTIN_FUNCTION
, 0},
387 {"MIN", UNOP_MIN
, PREC_BUILTIN_FUNCTION
, 0},
388 {"ODD", UNOP_ODD
, PREC_BUILTIN_FUNCTION
, 0},
389 {"TRUNC", UNOP_TRUNC
, PREC_BUILTIN_FUNCTION
, 0},
393 /* The built-in types of Modula-2. */
395 struct type
*builtin_type_m2_char
;
396 struct type
*builtin_type_m2_int
;
397 struct type
*builtin_type_m2_card
;
398 struct type
*builtin_type_m2_real
;
399 struct type
*builtin_type_m2_bool
;
401 struct type
** const (m2_builtin_types
[]) =
403 &builtin_type_m2_char
,
404 &builtin_type_m2_int
,
405 &builtin_type_m2_card
,
406 &builtin_type_m2_real
,
407 &builtin_type_m2_bool
,
411 const struct language_defn m2_language_defn
= {
417 m2_parse
, /* parser */
418 m2_error
, /* parser error function */
419 evaluate_subexp_standard
,
420 m2_printchar
, /* Print character constant */
421 m2_printstr
, /* function to print string constant */
422 m2_create_fundamental_type
, /* Create fundamental type in this language */
423 m2_print_type
, /* Print a type using appropriate syntax */
424 m2_val_print
, /* Print a value using appropriate syntax */
425 c_value_print
, /* Print a top-level value */
426 {"", "", "", ""}, /* Binary format info */
427 {"%loB", "", "o", "B"}, /* Octal format info */
428 {"%ld", "", "d", ""}, /* Decimal format info */
429 {"0%lXH", "0", "X", "H"}, /* Hex format info */
430 m2_op_print_tab
, /* expression operators for printing */
431 0, /* arrays are first-class (not c-style) */
432 0, /* String lower bound */
433 &builtin_type_m2_char
, /* Type of string elements */
437 /* Initialization for Modula-2 */
440 _initialize_m2_language ()
442 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
443 builtin_type_m2_int
=
444 init_type (TYPE_CODE_INT
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
446 "INTEGER", (struct objfile
*) NULL
);
447 builtin_type_m2_card
=
448 init_type (TYPE_CODE_INT
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
450 "CARDINAL", (struct objfile
*) NULL
);
451 builtin_type_m2_real
=
452 init_type (TYPE_CODE_FLT
, TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
454 "REAL", (struct objfile
*) NULL
);
455 builtin_type_m2_char
=
456 init_type (TYPE_CODE_CHAR
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
458 "CHAR", (struct objfile
*) NULL
);
459 builtin_type_m2_bool
=
460 init_type (TYPE_CODE_BOOL
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
462 "BOOLEAN", (struct objfile
*) NULL
);
464 add_language (&m2_language_defn
);