1/* Modula 2 language support routines for GDB, the GNU debugger. 2 3 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004, 4 2005, 2007 Free Software Foundation, Inc. 5 6 This file is part of GDB. 7 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. 12 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. 17 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/>. */ 20 21#include "defs.h" 22#include "symtab.h" 23#include "gdbtypes.h" 24#include "expression.h" 25#include "parser-defs.h" 26#include "language.h" 27#include "m2-lang.h" 28#include "c-lang.h" 29#include "valprint.h" 30 31extern void _initialize_m2_language (void); 32static struct type *m2_create_fundamental_type (struct objfile *, int); 33static void m2_printchar (int, struct ui_file *); 34static void m2_emit_char (int, struct ui_file *, int); 35 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. 41 */ 42 43static void 44m2_emit_char (int c, struct ui_file *stream, int quoter) 45{ 46 47 c &= 0xFF; /* Avoid sign bit follies */ 48 49 if (PRINT_LITERAL_FORM (c)) 50 { 51 if (c == '\\' || c == quoter) 52 { 53 fputs_filtered ("\\", stream); 54 } 55 fprintf_filtered (stream, "%c", c); 56 } 57 else 58 { 59 switch (c) 60 { 61 case '\n': 62 fputs_filtered ("\\n", stream); 63 break; 64 case '\b': 65 fputs_filtered ("\\b", stream); 66 break; 67 case '\t': 68 fputs_filtered ("\\t", stream); 69 break; 70 case '\f': 71 fputs_filtered ("\\f", stream); 72 break; 73 case '\r': 74 fputs_filtered ("\\r", stream); 75 break; 76 case '\033': 77 fputs_filtered ("\\e", stream); 78 break; 79 case '\007': 80 fputs_filtered ("\\a", stream); 81 break; 82 default: 83 fprintf_filtered (stream, "\\%.3o", (unsigned int) c); 84 break; 85 } 86 } 87} 88 89/* FIXME: This is a copy of the same function from c-exp.y. It should 90 be replaced with a true Modula version. */ 91 92static void 93m2_printchar (int c, struct ui_file *stream) 94{ 95 fputs_filtered ("'", stream); 96 LA_EMIT_CHAR (c, stream, '\''); 97 fputs_filtered ("'", stream); 98} 99 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. */ 106 107static void 108m2_printstr (struct ui_file *stream, const gdb_byte *string, 109 unsigned int length, int width, int force_ellipses) 110{ 111 unsigned int i; 112 unsigned int things_printed = 0; 113 int in_quotes = 0; 114 int need_comma = 0; 115 116 if (length == 0) 117 { 118 fputs_filtered ("\"\"", gdb_stdout); 119 return; 120 } 121 122 for (i = 0; i < length && things_printed < print_max; ++i) 123 { 124 /* Position of the character we are examining 125 to see whether it is repeated. */ 126 unsigned int rep1; 127 /* Number of repetitions we have detected so far. */ 128 unsigned int reps; 129 130 QUIT; 131 132 if (need_comma) 133 { 134 fputs_filtered (", ", stream); 135 need_comma = 0; 136 } 137 138 rep1 = i + 1; 139 reps = 1; 140 while (rep1 < length && string[rep1] == string[i]) 141 { 142 ++rep1; 143 ++reps; 144 } 145 146 if (reps > repeat_count_threshold) 147 { 148 if (in_quotes) 149 { 150 if (inspect_it) 151 fputs_filtered ("\\\", ", stream); 152 else 153 fputs_filtered ("\", ", stream); 154 in_quotes = 0; 155 } 156 m2_printchar (string[i], stream); 157 fprintf_filtered (stream, " <repeats %u times>", reps); 158 i = rep1 - 1; 159 things_printed += repeat_count_threshold; 160 need_comma = 1; 161 } 162 else 163 { 164 if (!in_quotes) 165 { 166 if (inspect_it) 167 fputs_filtered ("\\\"", stream); 168 else 169 fputs_filtered ("\"", stream); 170 in_quotes = 1; 171 } 172 LA_EMIT_CHAR (string[i], stream, '"'); 173 ++things_printed; 174 } 175 } 176 177 /* Terminate the quotes if necessary. */ 178 if (in_quotes) 179 { 180 if (inspect_it) 181 fputs_filtered ("\\\"", stream); 182 else 183 fputs_filtered ("\"", stream); 184 } 185 186 if (force_ellipses || i < length) 187 fputs_filtered ("...", stream); 188} 189 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. */ 193 194static struct type * 195m2_create_fundamental_type (struct objfile *objfile, int typeid) 196{ 197 struct type *type = NULL; 198 199 switch (typeid) 200 { 201 default: 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); 210 break; 211 case FT_VOID: 212 type = init_type (TYPE_CODE_VOID, 213 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 214 0, "void", objfile); 215 break; 216 case FT_BOOLEAN: 217 type = init_type (TYPE_CODE_BOOL, 218 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 219 TYPE_FLAG_UNSIGNED, "boolean", objfile); 220 break; 221 case FT_STRING: 222 type = init_type (TYPE_CODE_STRING, 223 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 224 0, "string", objfile); 225 break; 226 case FT_CHAR: 227 type = init_type (TYPE_CODE_INT, 228 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 229 0, "char", objfile); 230 break; 231 case FT_SIGNED_CHAR: 232 type = init_type (TYPE_CODE_INT, 233 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 234 0, "signed char", objfile); 235 break; 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); 240 break; 241 case FT_SHORT: 242 type = init_type (TYPE_CODE_INT, 243 gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT, 244 0, "short", objfile); 245 break; 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 */ 250 break; 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); 255 break; 256 case FT_INTEGER: 257 type = init_type (TYPE_CODE_INT, 258 gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, 259 0, "int", objfile); 260 break; 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 */ 265 break; 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); 270 break; 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); 275 break; 276 case FT_LONG: 277 type = init_type (TYPE_CODE_INT, 278 gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, 279 0, "long", objfile); 280 break; 281 case FT_SIGNED_LONG: 282 type = init_type (TYPE_CODE_INT, 283 gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, 284 0, "long", objfile); /* FIXME -fnf */ 285 break; 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); 290 break; 291 case FT_LONG_LONG: 292 type = init_type (TYPE_CODE_INT, 293 gdbarch_long_long_bit (current_gdbarch) 294 / TARGET_CHAR_BIT, 295 0, "long long", objfile); 296 break; 297 case FT_SIGNED_LONG_LONG: 298 type = init_type (TYPE_CODE_INT, 299 gdbarch_long_long_bit (current_gdbarch) 300 / TARGET_CHAR_BIT, 301 0, "signed long long", objfile); 302 break; 303 case FT_UNSIGNED_LONG_LONG: 304 type = init_type (TYPE_CODE_INT, 305 gdbarch_long_long_bit (current_gdbarch) 306 / TARGET_CHAR_BIT, 307 TYPE_FLAG_UNSIGNED, "unsigned long long", objfile); 308 break; 309 case FT_FLOAT: 310 type = init_type (TYPE_CODE_FLT, 311 gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT, 312 0, "float", objfile); 313 break; 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); 318 break; 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); 323 break; 324 case FT_EXT_PREC_FLOAT: 325 type = init_type (TYPE_CODE_FLT, 326 gdbarch_long_double_bit (current_gdbarch) 327 / TARGET_CHAR_BIT, 328 0, "long double", objfile); 329 break; 330 case FT_COMPLEX: 331 type = init_type (TYPE_CODE_COMPLEX, 332 2 * gdbarch_float_bit (current_gdbarch) 333 / TARGET_CHAR_BIT, 334 0, "complex", objfile); 335 TYPE_TARGET_TYPE (type) 336 = m2_create_fundamental_type (objfile, FT_FLOAT); 337 break; 338 case FT_DBL_PREC_COMPLEX: 339 type = init_type (TYPE_CODE_COMPLEX, 340 2 * gdbarch_double_bit (current_gdbarch) 341 / TARGET_CHAR_BIT, 342 0, "double complex", objfile); 343 TYPE_TARGET_TYPE (type) 344 = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT); 345 break; 346 case FT_EXT_PREC_COMPLEX: 347 type = init_type (TYPE_CODE_COMPLEX, 348 2 * gdbarch_long_double_bit (current_gdbarch) 349 / TARGET_CHAR_BIT, 350 0, "long double complex", objfile); 351 TYPE_TARGET_TYPE (type) 352 = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT); 353 break; 354 } 355 return (type); 356} 357 358 359/* Table of operators and their precedences for printing expressions. */ 360 361static const struct op_print m2_op_print_tab[] = 362{ 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}, 392 {NULL, 0, 0, 0} 393}; 394 395/* The built-in types of Modula-2. */ 396 397enum 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 404}; 405 406static void 407m2_language_arch_info (struct gdbarch *gdbarch, 408 struct language_arch_info *lai) 409{ 410 const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch); 411 412 lai->string_char_type = builtin->builtin_char; 413 lai->primitive_type_vector 414 = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1, 415 struct type *); 416 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; 427} 428 429const struct language_defn m2_language_defn = 430{ 431 "modula-2", 432 language_m2, 433 NULL, 434 range_check_on, 435 type_check_on, 436 case_sensitive_on, 437 array_row_major, 438 &exp_descriptor_standard, 439 m2_parse, /* parser */ 440 m2_error, /* parser error function */ 441 null_post_parser, 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 */ 458 NULL, 459 default_word_break_characters, 460 m2_language_arch_info, 461 default_print_array_index, 462 LANG_MAGIC 463}; 464 465static void * 466build_m2_types (struct gdbarch *gdbarch) 467{ 468 struct builtin_m2_type *builtin_m2_type 469 = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type); 470 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, 479 TYPE_FLAG_UNSIGNED, 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, 484 0, 485 "REAL", (struct objfile *) NULL); 486 builtin_m2_type->builtin_char = 487 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT, 488 TYPE_FLAG_UNSIGNED, 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, 493 TYPE_FLAG_UNSIGNED, 494 "BOOLEAN", (struct objfile *) NULL); 495 496 return builtin_m2_type; 497} 498 499static struct gdbarch_data *m2_type_data; 500 501const struct builtin_m2_type * 502builtin_m2_type (struct gdbarch *gdbarch) 503{ 504 return gdbarch_data (gdbarch, m2_type_data); 505} 506 507 508/* Initialization for Modula-2 */ 509 510void 511_initialize_m2_language (void) 512{ 513 m2_type_data = gdbarch_data_register_post_init (build_m2_types); 514 515 add_language (&m2_language_defn); 516} 517