1 /* Modula 2 language support routines for GDB, the GNU debugger.
2 Copyright 1992, 1993, 1994, 1995, 1996, 1998, 2000
3 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include "expression.h"
26 #include "parser-defs.h"
32 extern void _initialize_m2_language (void);
33 static struct type
*m2_create_fundamental_type (struct objfile
*, int);
34 static void m2_printstr (struct ui_file
* stream
, char *string
,
35 unsigned int length
, int width
,
37 static void m2_printchar (int, struct ui_file
*);
38 static void m2_emit_char (int, struct ui_file
*, int);
40 /* Print the character C on STREAM as part of the contents of a literal
41 string whose delimiter is QUOTER. Note that that format for printing
42 characters and strings is language specific.
43 FIXME: This is a copy of the same function from c-exp.y. It should
44 be replaced with a true Modula version.
48 m2_emit_char (register int c
, struct ui_file
*stream
, int quoter
)
51 c
&= 0xFF; /* Avoid sign bit follies */
53 if (PRINT_LITERAL_FORM (c
))
55 if (c
== '\\' || c
== quoter
)
57 fputs_filtered ("\\", stream
);
59 fprintf_filtered (stream
, "%c", c
);
66 fputs_filtered ("\\n", stream
);
69 fputs_filtered ("\\b", stream
);
72 fputs_filtered ("\\t", stream
);
75 fputs_filtered ("\\f", stream
);
78 fputs_filtered ("\\r", stream
);
81 fputs_filtered ("\\e", stream
);
84 fputs_filtered ("\\a", stream
);
87 fprintf_filtered (stream
, "\\%.3o", (unsigned int) c
);
93 /* FIXME: This is a copy of the same function from c-exp.y. It should
94 be replaced with a true Modula version. */
97 m2_printchar (int c
, struct ui_file
*stream
)
99 fputs_filtered ("'", stream
);
100 LA_EMIT_CHAR (c
, stream
, '\'');
101 fputs_filtered ("'", stream
);
104 /* Print the character string STRING, printing at most LENGTH characters.
105 Printing stops early if the number hits print_max; repeat counts
106 are printed as appropriate. Print ellipses at the end if we
107 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
108 FIXME: This is a copy of the same function from c-exp.y. It should
109 be replaced with a true Modula version. */
112 m2_printstr (struct ui_file
*stream
, char *string
, unsigned int length
,
113 int width
, int force_ellipses
)
115 register unsigned int i
;
116 unsigned int things_printed
= 0;
119 extern int inspect_it
;
123 fputs_filtered ("\"\"", gdb_stdout
);
127 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
129 /* Position of the character we are examining
130 to see whether it is repeated. */
132 /* Number of repetitions we have detected so far. */
139 fputs_filtered (", ", stream
);
145 while (rep1
< length
&& string
[rep1
] == string
[i
])
151 if (reps
> repeat_count_threshold
)
156 fputs_filtered ("\\\", ", stream
);
158 fputs_filtered ("\", ", stream
);
161 m2_printchar (string
[i
], stream
);
162 fprintf_filtered (stream
, " <repeats %u times>", reps
);
164 things_printed
+= repeat_count_threshold
;
172 fputs_filtered ("\\\"", stream
);
174 fputs_filtered ("\"", stream
);
177 LA_EMIT_CHAR (string
[i
], stream
, '"');
182 /* Terminate the quotes if necessary. */
186 fputs_filtered ("\\\"", stream
);
188 fputs_filtered ("\"", stream
);
191 if (force_ellipses
|| i
< length
)
192 fputs_filtered ("...", stream
);
195 /* FIXME: This is a copy of c_create_fundamental_type(), before
196 all the non-C types were stripped from it. Needs to be fixed
197 by an experienced Modula programmer. */
200 m2_create_fundamental_type (struct objfile
*objfile
, int typeid)
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 0, "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 0, "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 0, "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 0, "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 0, "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_COMPLEX
,
333 2 * TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
334 0, "complex", objfile
);
335 TYPE_TARGET_TYPE (type
)
336 = m2_create_fundamental_type (objfile
, FT_FLOAT
);
338 case FT_DBL_PREC_COMPLEX
:
339 type
= init_type (TYPE_CODE_COMPLEX
,
340 2 * TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
341 0, "double complex", objfile
);
342 TYPE_TARGET_TYPE (type
)
343 = m2_create_fundamental_type (objfile
, FT_DBL_PREC_FLOAT
);
345 case FT_EXT_PREC_COMPLEX
:
346 type
= init_type (TYPE_CODE_COMPLEX
,
347 2 * TARGET_LONG_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
348 0, "long double complex", objfile
);
349 TYPE_TARGET_TYPE (type
)
350 = m2_create_fundamental_type (objfile
, FT_EXT_PREC_FLOAT
);
357 /* Table of operators and their precedences for printing expressions. */
359 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_PTR (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
=
419 m2_parse
, /* parser */
420 m2_error
, /* parser error function */
421 evaluate_subexp_standard
,
422 m2_printchar
, /* Print character constant */
423 m2_printstr
, /* function to print string constant */
424 m2_emit_char
, /* Function to print a single character */
425 m2_create_fundamental_type
, /* Create fundamental type in this language */
426 m2_print_type
, /* Print a type using appropriate syntax */
427 m2_val_print
, /* Print a value using appropriate syntax */
428 c_value_print
, /* Print a top-level value */
429 {"", "", "", ""}, /* Binary format info */
430 {"%loB", "", "o", "B"}, /* Octal format info */
431 {"%ld", "", "d", ""}, /* Decimal format info */
432 {"0%lXH", "0", "X", "H"}, /* Hex format info */
433 m2_op_print_tab
, /* expression operators for printing */
434 0, /* arrays are first-class (not c-style) */
435 0, /* String lower bound */
436 &builtin_type_m2_char
, /* Type of string elements */
440 /* Initialization for Modula-2 */
443 _initialize_m2_language (void)
445 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
446 builtin_type_m2_int
=
447 init_type (TYPE_CODE_INT
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
449 "INTEGER", (struct objfile
*) NULL
);
450 builtin_type_m2_card
=
451 init_type (TYPE_CODE_INT
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
453 "CARDINAL", (struct objfile
*) NULL
);
454 builtin_type_m2_real
=
455 init_type (TYPE_CODE_FLT
, TARGET_FLOAT_BIT
/ TARGET_CHAR_BIT
,
457 "REAL", (struct objfile
*) NULL
);
458 builtin_type_m2_char
=
459 init_type (TYPE_CODE_CHAR
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
461 "CHAR", (struct objfile
*) NULL
);
462 builtin_type_m2_bool
=
463 init_type (TYPE_CODE_BOOL
, TARGET_INT_BIT
/ TARGET_CHAR_BIT
,
465 "BOOLEAN", (struct objfile
*) NULL
);
467 add_language (&m2_language_defn
);