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
;
207 /* FIXME: For now, if we are asked to produce a type not in this
208 language, create the equivalent of a C integer type with the
209 name "<?type?>". When all the dust settles from the type
210 reconstruction work, this should probably become an error. */
211 type
= init_type (TYPE_CODE_INT
,
212 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
213 0, "<?type?>", objfile
);
214 warning ("internal error: no Modula fundamental type %d", typeid);
217 type
= init_type (TYPE_CODE_VOID
,
218 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
222 type
= init_type (TYPE_CODE_BOOL
,
223 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
224 TYPE_FLAG_UNSIGNED
, "boolean", objfile
);
227 type
= init_type (TYPE_CODE_STRING
,
228 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
229 0, "string", objfile
);
232 type
= init_type (TYPE_CODE_INT
,
233 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
237 type
= init_type (TYPE_CODE_INT
,
238 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
239 TYPE_FLAG_SIGNED
, "signed char", objfile
);
241 case FT_UNSIGNED_CHAR
:
242 type
= init_type (TYPE_CODE_INT
,
243 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
244 TYPE_FLAG_UNSIGNED
, "unsigned char", objfile
);
247 type
= init_type (TYPE_CODE_INT
,
248 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
249 0, "short", objfile
);
251 case FT_SIGNED_SHORT
:
252 type
= init_type (TYPE_CODE_INT
,
253 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
254 TYPE_FLAG_SIGNED
, "short", objfile
); /* FIXME-fnf */
256 case FT_UNSIGNED_SHORT
:
257 type
= init_type (TYPE_CODE_INT
,
258 TARGET_SHORT_BIT
/ TARGET_CHAR_BIT
,
259 TYPE_FLAG_UNSIGNED
, "unsigned short", objfile
);
262 type
= init_type (TYPE_CODE_INT
,
263 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
266 case FT_SIGNED_INTEGER
:
267 type
= init_type (TYPE_CODE_INT
,
268 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
269 TYPE_FLAG_SIGNED
, "int", objfile
); /* FIXME -fnf */
271 case FT_UNSIGNED_INTEGER
:
272 type
= init_type (TYPE_CODE_INT
,
273 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
274 TYPE_FLAG_UNSIGNED
, "unsigned int", objfile
);
276 case FT_FIXED_DECIMAL
:
277 type
= init_type (TYPE_CODE_INT
,
278 TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
279 0, "fixed decimal", objfile
);
282 type
= init_type (TYPE_CODE_INT
,
283 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
287 type
= init_type (TYPE_CODE_INT
,
288 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
289 TYPE_FLAG_SIGNED
, "long", objfile
); /* FIXME -fnf */
291 case FT_UNSIGNED_LONG
:
292 type
= init_type (TYPE_CODE_INT
,
293 TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
294 TYPE_FLAG_UNSIGNED
, "unsigned long", objfile
);
297 type
= init_type (TYPE_CODE_INT
,
298 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
299 0, "long long", objfile
);
301 case FT_SIGNED_LONG_LONG
:
302 type
= init_type (TYPE_CODE_INT
,
303 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
304 TYPE_FLAG_SIGNED
, "signed long long", objfile
);
306 case FT_UNSIGNED_LONG_LONG
:
307 type
= init_type (TYPE_CODE_INT
,
308 TARGET_LONG_LONG_BIT
/ TARGET_CHAR_BIT
,
309 TYPE_FLAG_UNSIGNED
, "unsigned long long", objfile
);
312 type
= init_type (TYPE_CODE_FLT
,
313 TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
314 0, "float", objfile
);
316 case FT_DBL_PREC_FLOAT
:
317 type
= init_type (TYPE_CODE_FLT
,
318 TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
319 0, "double", objfile
);
321 case FT_FLOAT_DECIMAL
:
322 type
= init_type (TYPE_CODE_FLT
,
323 TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
324 0, "floating decimal", objfile
);
326 case FT_EXT_PREC_FLOAT
:
327 type
= init_type (TYPE_CODE_FLT
,
328 TARGET_LONG_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
329 0, "long double", objfile
);
332 type
= init_type (TYPE_CODE_FLT
,
333 TARGET_COMPLEX_BIT
/ TARGET_CHAR_BIT
,
334 0, "complex", objfile
);
336 case FT_DBL_PREC_COMPLEX
:
337 type
= init_type (TYPE_CODE_FLT
,
338 TARGET_DOUBLE_COMPLEX_BIT
/ TARGET_CHAR_BIT
,
339 0, "double complex", objfile
);
341 case FT_EXT_PREC_COMPLEX
:
342 type
= init_type (TYPE_CODE_FLT
,
343 TARGET_DOUBLE_COMPLEX_BIT
/ TARGET_CHAR_BIT
,
344 0, "long double complex", objfile
);
351 /* Table of operators and their precedences for printing expressions. */
353 static const struct op_print m2_op_print_tab
[] = {
354 {"+", BINOP_ADD
, PREC_ADD
, 0},
355 {"+", UNOP_PLUS
, PREC_PREFIX
, 0},
356 {"-", BINOP_SUB
, PREC_ADD
, 0},
357 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
358 {"*", BINOP_MUL
, PREC_MUL
, 0},
359 {"/", BINOP_DIV
, PREC_MUL
, 0},
360 {"DIV", BINOP_INTDIV
, PREC_MUL
, 0},
361 {"MOD", BINOP_REM
, PREC_MUL
, 0},
362 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
363 {"OR", BINOP_LOGICAL_OR
, PREC_LOGICAL_OR
, 0},
364 {"AND", BINOP_LOGICAL_AND
, PREC_LOGICAL_AND
, 0},
365 {"NOT", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
366 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
367 {"<>", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
368 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
369 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
370 {">", BINOP_GTR
, PREC_ORDER
, 0},
371 {"<", BINOP_LESS
, PREC_ORDER
, 0},
372 {"^", UNOP_IND
, PREC_PREFIX
, 0},
373 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
377 /* The built-in types of Modula-2. */
379 struct type
*builtin_type_m2_char
;
380 struct type
*builtin_type_m2_int
;
381 struct type
*builtin_type_m2_card
;
382 struct type
*builtin_type_m2_real
;
383 struct type
*builtin_type_m2_bool
;
385 struct type
** const (m2_builtin_types
[]) =
387 &builtin_type_m2_char
,
388 &builtin_type_m2_int
,
389 &builtin_type_m2_card
,
390 &builtin_type_m2_real
,
391 &builtin_type_m2_bool
,
395 const struct language_defn m2_language_defn
= {
401 m2_parse
, /* parser */
402 m2_error
, /* parser error function */
403 m2_printchar
, /* Print character constant */
404 m2_printstr
, /* function to print string constant */
405 m2_create_fundamental_type
, /* Create fundamental type in this language */
406 m2_print_type
, /* Print a type using appropriate syntax */
407 m2_val_print
, /* Print a value using appropriate syntax */
408 &builtin_type_m2_int
, /* longest signed integral type */
409 &builtin_type_m2_card
, /* longest unsigned integral type */
410 &builtin_type_m2_real
, /* longest floating point type */
411 {"", "", "", ""}, /* Binary format info */
412 {"%oB", "", "o", "B"}, /* Octal format info */
413 {"%d", "", "d", ""}, /* Decimal format info */
414 {"0%XH", "0", "X", "H"}, /* Hex format info */
415 m2_op_print_tab
, /* expression operators for printing */
419 /* Initialization for Modula-2 */
422 _initialize_m2_language ()
424 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
425 builtin_type_m2_int
=
426 init_type (TYPE_CODE_INT
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
428 "INTEGER", (struct objfile
*) NULL
);
429 builtin_type_m2_card
=
430 init_type (TYPE_CODE_INT
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
432 "CARDINAL", (struct objfile
*) NULL
);
433 builtin_type_m2_real
=
434 init_type (TYPE_CODE_FLT
, TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
436 "REAL", (struct objfile
*) NULL
);
437 builtin_type_m2_char
=
438 init_type (TYPE_CODE_CHAR
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
440 "CHAR", (struct objfile
*) NULL
);
441 builtin_type_m2_bool
=
442 init_type (TYPE_CODE_BOOL
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
444 "BOOLEAN", (struct objfile
*) NULL
);
446 TYPE_NFIELDS(builtin_type_m2_bool
) = 2;
447 TYPE_FIELDS(builtin_type_m2_bool
) =
448 (struct field
*) xmalloc (sizeof (struct field
) * 2);
449 TYPE_FIELD_BITPOS(builtin_type_m2_bool
,0) = 0;
450 TYPE_FIELD_NAME(builtin_type_m2_bool
,0) = (char *)xmalloc(6);
451 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool
,0),"FALSE");
452 TYPE_FIELD_BITPOS(builtin_type_m2_bool
,1) = 1;
453 TYPE_FIELD_NAME(builtin_type_m2_bool
,1) = (char *)xmalloc(5);
454 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool
,1),"TRUE");
456 add_language (&m2_language_defn
);