1 /* Modula 2 language support routines for GDB, the GNU debugger.
3 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
4 2005, 2007 Free Software Foundation, Inc.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
24 #include "expression.h"
25 #include "parser-defs.h"
31 extern void _initialize_m2_language (void);
32 static struct type
*m2_create_fundamental_type (struct objfile
*, int);
33 static void m2_printchar (int, struct ui_file
*);
34 static void m2_emit_char (int, struct ui_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 (int c
, struct ui_file
*stream
, int quoter
)
47 c
&= 0xFF; /* Avoid sign bit follies */
49 if (PRINT_LITERAL_FORM (c
))
51 if (c
== '\\' || c
== quoter
)
53 fputs_filtered ("\\", stream
);
55 fprintf_filtered (stream
, "%c", c
);
62 fputs_filtered ("\\n", stream
);
65 fputs_filtered ("\\b", stream
);
68 fputs_filtered ("\\t", stream
);
71 fputs_filtered ("\\f", stream
);
74 fputs_filtered ("\\r", stream
);
77 fputs_filtered ("\\e", stream
);
80 fputs_filtered ("\\a", stream
);
83 fprintf_filtered (stream
, "\\%.3o", (unsigned int) c
);
89 /* FIXME: This is a copy of the same function from c-exp.y. It should
90 be replaced with a true Modula version. */
93 m2_printchar (int c
, struct ui_file
*stream
)
95 fputs_filtered ("'", stream
);
96 LA_EMIT_CHAR (c
, stream
, '\'');
97 fputs_filtered ("'", stream
);
100 /* Print the character string STRING, printing at most LENGTH characters.
101 Printing stops early if the number hits print_max; repeat counts
102 are printed as appropriate. Print ellipses at the end if we
103 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
104 FIXME: This is a copy of the same function from c-exp.y. It should
105 be replaced with a true Modula version. */
108 m2_printstr (struct ui_file
*stream
, const gdb_byte
*string
,
109 unsigned int length
, int width
, int force_ellipses
)
112 unsigned int things_printed
= 0;
118 fputs_filtered ("\"\"", gdb_stdout
);
122 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
124 /* Position of the character we are examining
125 to see whether it is repeated. */
127 /* Number of repetitions we have detected so far. */
134 fputs_filtered (", ", stream
);
140 while (rep1
< length
&& string
[rep1
] == string
[i
])
146 if (reps
> repeat_count_threshold
)
151 fputs_filtered ("\\\", ", stream
);
153 fputs_filtered ("\", ", stream
);
156 m2_printchar (string
[i
], stream
);
157 fprintf_filtered (stream
, " <repeats %u times>", reps
);
159 things_printed
+= repeat_count_threshold
;
167 fputs_filtered ("\\\"", stream
);
169 fputs_filtered ("\"", stream
);
172 LA_EMIT_CHAR (string
[i
], stream
, '"');
177 /* Terminate the quotes if necessary. */
181 fputs_filtered ("\\\"", stream
);
183 fputs_filtered ("\"", stream
);
186 if (force_ellipses
|| i
< length
)
187 fputs_filtered ("...", stream
);
190 /* FIXME: This is a copy of c_create_fundamental_type(), before
191 all the non-C types were stripped from it. Needs to be fixed
192 by an experienced Modula programmer. */
195 m2_create_fundamental_type (struct objfile
*objfile
, int typeid)
197 struct type
*type
= NULL
;
202 /* FIXME: For now, if we are asked to produce a type not in this
203 language, create the equivalent of a C integer type with the
204 name "<?type?>". When all the dust settles from the type
205 reconstruction work, this should probably become an error. */
206 type
= init_type (TYPE_CODE_INT
,
207 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
208 0, "<?type?>", objfile
);
209 warning (_("internal error: no Modula fundamental type %d"), typeid);
212 type
= init_type (TYPE_CODE_VOID
,
213 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
217 type
= init_type (TYPE_CODE_BOOL
,
218 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
219 TYPE_FLAG_UNSIGNED
, "boolean", objfile
);
222 type
= init_type (TYPE_CODE_STRING
,
223 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
224 0, "string", objfile
);
227 type
= init_type (TYPE_CODE_INT
,
228 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
232 type
= init_type (TYPE_CODE_INT
,
233 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
234 0, "signed char", objfile
);
236 case FT_UNSIGNED_CHAR
:
237 type
= init_type (TYPE_CODE_INT
,
238 TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
239 TYPE_FLAG_UNSIGNED
, "unsigned char", objfile
);
242 type
= init_type (TYPE_CODE_INT
,
243 gdbarch_short_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
244 0, "short", objfile
);
246 case FT_SIGNED_SHORT
:
247 type
= init_type (TYPE_CODE_INT
,
248 gdbarch_short_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
249 0, "short", objfile
); /* FIXME-fnf */
251 case FT_UNSIGNED_SHORT
:
252 type
= init_type (TYPE_CODE_INT
,
253 gdbarch_short_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
254 TYPE_FLAG_UNSIGNED
, "unsigned short", objfile
);
257 type
= init_type (TYPE_CODE_INT
,
258 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
261 case FT_SIGNED_INTEGER
:
262 type
= init_type (TYPE_CODE_INT
,
263 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
264 0, "int", objfile
); /* FIXME -fnf */
266 case FT_UNSIGNED_INTEGER
:
267 type
= init_type (TYPE_CODE_INT
,
268 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
269 TYPE_FLAG_UNSIGNED
, "unsigned int", objfile
);
271 case FT_FIXED_DECIMAL
:
272 type
= init_type (TYPE_CODE_INT
,
273 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
274 0, "fixed decimal", objfile
);
277 type
= init_type (TYPE_CODE_INT
,
278 gdbarch_long_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
282 type
= init_type (TYPE_CODE_INT
,
283 gdbarch_long_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
284 0, "long", objfile
); /* FIXME -fnf */
286 case FT_UNSIGNED_LONG
:
287 type
= init_type (TYPE_CODE_INT
,
288 gdbarch_long_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
289 TYPE_FLAG_UNSIGNED
, "unsigned long", objfile
);
292 type
= init_type (TYPE_CODE_INT
,
293 gdbarch_long_long_bit (current_gdbarch
)
295 0, "long long", objfile
);
297 case FT_SIGNED_LONG_LONG
:
298 type
= init_type (TYPE_CODE_INT
,
299 gdbarch_long_long_bit (current_gdbarch
)
301 0, "signed long long", objfile
);
303 case FT_UNSIGNED_LONG_LONG
:
304 type
= init_type (TYPE_CODE_INT
,
305 gdbarch_long_long_bit (current_gdbarch
)
307 TYPE_FLAG_UNSIGNED
, "unsigned long long", objfile
);
310 type
= init_type (TYPE_CODE_FLT
,
311 gdbarch_float_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
312 0, "float", objfile
);
314 case FT_DBL_PREC_FLOAT
:
315 type
= init_type (TYPE_CODE_FLT
,
316 gdbarch_double_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
317 0, "double", objfile
);
319 case FT_FLOAT_DECIMAL
:
320 type
= init_type (TYPE_CODE_FLT
,
321 gdbarch_double_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
322 0, "floating decimal", objfile
);
324 case FT_EXT_PREC_FLOAT
:
325 type
= init_type (TYPE_CODE_FLT
,
326 gdbarch_long_double_bit (current_gdbarch
)
328 0, "long double", objfile
);
331 type
= init_type (TYPE_CODE_COMPLEX
,
332 2 * gdbarch_float_bit (current_gdbarch
)
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 * gdbarch_double_bit (current_gdbarch
)
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 * gdbarch_long_double_bit (current_gdbarch
)
350 0, "long double complex", objfile
);
351 TYPE_TARGET_TYPE (type
)
352 = m2_create_fundamental_type (objfile
, FT_EXT_PREC_FLOAT
);
359 /* Table of operators and their precedences for printing expressions. */
361 static const struct op_print m2_op_print_tab
[] =
363 {"+", BINOP_ADD
, PREC_ADD
, 0},
364 {"+", UNOP_PLUS
, PREC_PREFIX
, 0},
365 {"-", BINOP_SUB
, PREC_ADD
, 0},
366 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
367 {"*", BINOP_MUL
, PREC_MUL
, 0},
368 {"/", BINOP_DIV
, PREC_MUL
, 0},
369 {"DIV", BINOP_INTDIV
, PREC_MUL
, 0},
370 {"MOD", BINOP_REM
, PREC_MUL
, 0},
371 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
372 {"OR", BINOP_LOGICAL_OR
, PREC_LOGICAL_OR
, 0},
373 {"AND", BINOP_LOGICAL_AND
, PREC_LOGICAL_AND
, 0},
374 {"NOT", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
375 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
376 {"<>", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
377 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
378 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
379 {">", BINOP_GTR
, PREC_ORDER
, 0},
380 {"<", BINOP_LESS
, PREC_ORDER
, 0},
381 {"^", UNOP_IND
, PREC_PREFIX
, 0},
382 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
383 {"CAP", UNOP_CAP
, PREC_BUILTIN_FUNCTION
, 0},
384 {"CHR", UNOP_CHR
, PREC_BUILTIN_FUNCTION
, 0},
385 {"ORD", UNOP_ORD
, PREC_BUILTIN_FUNCTION
, 0},
386 {"FLOAT", UNOP_FLOAT
, PREC_BUILTIN_FUNCTION
, 0},
387 {"HIGH", UNOP_HIGH
, PREC_BUILTIN_FUNCTION
, 0},
388 {"MAX", UNOP_MAX
, PREC_BUILTIN_FUNCTION
, 0},
389 {"MIN", UNOP_MIN
, PREC_BUILTIN_FUNCTION
, 0},
390 {"ODD", UNOP_ODD
, PREC_BUILTIN_FUNCTION
, 0},
391 {"TRUNC", UNOP_TRUNC
, PREC_BUILTIN_FUNCTION
, 0},
395 /* The built-in types of Modula-2. */
397 enum m2_primitive_types
{
398 m2_primitive_type_char
,
399 m2_primitive_type_int
,
400 m2_primitive_type_card
,
401 m2_primitive_type_real
,
402 m2_primitive_type_bool
,
403 nr_m2_primitive_types
407 m2_language_arch_info (struct gdbarch
*gdbarch
,
408 struct language_arch_info
*lai
)
410 const struct builtin_m2_type
*builtin
= builtin_m2_type (gdbarch
);
412 lai
->string_char_type
= builtin
->builtin_char
;
413 lai
->primitive_type_vector
414 = GDBARCH_OBSTACK_CALLOC (gdbarch
, nr_m2_primitive_types
+ 1,
417 lai
->primitive_type_vector
[m2_primitive_type_char
]
418 = builtin
->builtin_char
;
419 lai
->primitive_type_vector
[m2_primitive_type_int
]
420 = builtin
->builtin_int
;
421 lai
->primitive_type_vector
[m2_primitive_type_card
]
422 = builtin
->builtin_card
;
423 lai
->primitive_type_vector
[m2_primitive_type_real
]
424 = builtin
->builtin_real
;
425 lai
->primitive_type_vector
[m2_primitive_type_bool
]
426 = builtin
->builtin_bool
;
429 const struct language_defn m2_language_defn
=
438 &exp_descriptor_standard
,
439 m2_parse
, /* parser */
440 m2_error
, /* parser error function */
442 m2_printchar
, /* Print character constant */
443 m2_printstr
, /* function to print string constant */
444 m2_emit_char
, /* Function to print a single character */
445 m2_create_fundamental_type
, /* Create fundamental type in this language */
446 m2_print_type
, /* Print a type using appropriate syntax */
447 m2_val_print
, /* Print a value using appropriate syntax */
448 c_value_print
, /* Print a top-level value */
449 NULL
, /* Language specific skip_trampoline */
450 value_of_this
, /* value_of_this */
451 basic_lookup_symbol_nonlocal
, /* lookup_symbol_nonlocal */
452 basic_lookup_transparent_type
,/* lookup_transparent_type */
453 NULL
, /* Language specific symbol demangler */
454 NULL
, /* Language specific class_name_from_physname */
455 m2_op_print_tab
, /* expression operators for printing */
456 0, /* arrays are first-class (not c-style) */
457 0, /* String lower bound */
459 default_word_break_characters
,
460 m2_language_arch_info
,
461 default_print_array_index
,
466 build_m2_types (struct gdbarch
*gdbarch
)
468 struct builtin_m2_type
*builtin_m2_type
469 = GDBARCH_OBSTACK_ZALLOC (gdbarch
, struct builtin_m2_type
);
471 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
472 builtin_m2_type
->builtin_int
=
473 init_type (TYPE_CODE_INT
,
474 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
475 0, "INTEGER", (struct objfile
*) NULL
);
476 builtin_m2_type
->builtin_card
=
477 init_type (TYPE_CODE_INT
,
478 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
480 "CARDINAL", (struct objfile
*) NULL
);
481 builtin_m2_type
->builtin_real
=
482 init_type (TYPE_CODE_FLT
,
483 gdbarch_float_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
485 "REAL", (struct objfile
*) NULL
);
486 builtin_m2_type
->builtin_char
=
487 init_type (TYPE_CODE_CHAR
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
489 "CHAR", (struct objfile
*) NULL
);
490 builtin_m2_type
->builtin_bool
=
491 init_type (TYPE_CODE_BOOL
,
492 gdbarch_int_bit (current_gdbarch
) / TARGET_CHAR_BIT
,
494 "BOOLEAN", (struct objfile
*) NULL
);
496 return builtin_m2_type
;
499 static struct gdbarch_data
*m2_type_data
;
501 const struct builtin_m2_type
*
502 builtin_m2_type (struct gdbarch
*gdbarch
)
504 return gdbarch_data (gdbarch
, m2_type_data
);
508 /* Initialization for Modula-2 */
511 _initialize_m2_language (void)
513 m2_type_data
= gdbarch_data_register_post_init (build_m2_types
);
515 add_language (&m2_language_defn
);