1/* Modula 2 language support routines for GDB, the GNU debugger. 2 Copyright 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004 3 Free Software Foundation, Inc. 4 5 This file is part of GDB. 6 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. 11 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. 16 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. */ 21 22#include "defs.h" 23#include "symtab.h" 24#include "gdbtypes.h" 25#include "expression.h" 26#include "parser-defs.h" 27#include "language.h" 28#include "m2-lang.h" 29#include "c-lang.h" 30#include "valprint.h" 31 32extern void _initialize_m2_language (void); 33static struct type *m2_create_fundamental_type (struct objfile *, int); 34static void m2_printstr (struct ui_file * stream, char *string, 35 unsigned int length, int width, 36 int force_ellipses); 37static void m2_printchar (int, struct ui_file *); 38static void m2_emit_char (int, struct ui_file *, int); 39 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. 45 */ 46 47static void 48m2_emit_char (int c, struct ui_file *stream, int quoter) 49{ 50 51 c &= 0xFF; /* Avoid sign bit follies */ 52 53 if (PRINT_LITERAL_FORM (c)) 54 { 55 if (c == '\\' || c == quoter) 56 { 57 fputs_filtered ("\\", stream); 58 } 59 fprintf_filtered (stream, "%c", c); 60 } 61 else 62 { 63 switch (c) 64 { 65 case '\n': 66 fputs_filtered ("\\n", stream); 67 break; 68 case '\b': 69 fputs_filtered ("\\b", stream); 70 break; 71 case '\t': 72 fputs_filtered ("\\t", stream); 73 break; 74 case '\f': 75 fputs_filtered ("\\f", stream); 76 break; 77 case '\r': 78 fputs_filtered ("\\r", stream); 79 break; 80 case '\033': 81 fputs_filtered ("\\e", stream); 82 break; 83 case '\007': 84 fputs_filtered ("\\a", stream); 85 break; 86 default: 87 fprintf_filtered (stream, "\\%.3o", (unsigned int) c); 88 break; 89 } 90 } 91} 92 93/* FIXME: This is a copy of the same function from c-exp.y. It should 94 be replaced with a true Modula version. */ 95 96static void 97m2_printchar (int c, struct ui_file *stream) 98{ 99 fputs_filtered ("'", stream); 100 LA_EMIT_CHAR (c, stream, '\''); 101 fputs_filtered ("'", stream); 102} 103 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. */ 110 111static void 112m2_printstr (struct ui_file *stream, char *string, unsigned int length, 113 int width, int force_ellipses) 114{ 115 unsigned int i; 116 unsigned int things_printed = 0; 117 int in_quotes = 0; 118 int need_comma = 0; 119 120 if (length == 0) 121 { 122 fputs_filtered ("\"\"", gdb_stdout); 123 return; 124 } 125 126 for (i = 0; i < length && things_printed < print_max; ++i) 127 { 128 /* Position of the character we are examining 129 to see whether it is repeated. */ 130 unsigned int rep1; 131 /* Number of repetitions we have detected so far. */ 132 unsigned int reps; 133 134 QUIT; 135 136 if (need_comma) 137 { 138 fputs_filtered (", ", stream); 139 need_comma = 0; 140 } 141 142 rep1 = i + 1; 143 reps = 1; 144 while (rep1 < length && string[rep1] == string[i]) 145 { 146 ++rep1; 147 ++reps; 148 } 149 150 if (reps > repeat_count_threshold) 151 { 152 if (in_quotes) 153 { 154 if (inspect_it) 155 fputs_filtered ("\\\", ", stream); 156 else 157 fputs_filtered ("\", ", stream); 158 in_quotes = 0; 159 } 160 m2_printchar (string[i], stream); 161 fprintf_filtered (stream, " <repeats %u times>", reps); 162 i = rep1 - 1; 163 things_printed += repeat_count_threshold; 164 need_comma = 1; 165 } 166 else 167 { 168 if (!in_quotes) 169 { 170 if (inspect_it) 171 fputs_filtered ("\\\"", stream); 172 else 173 fputs_filtered ("\"", stream); 174 in_quotes = 1; 175 } 176 LA_EMIT_CHAR (string[i], stream, '"'); 177 ++things_printed; 178 } 179 } 180 181 /* Terminate the quotes if necessary. */ 182 if (in_quotes) 183 { 184 if (inspect_it) 185 fputs_filtered ("\\\"", stream); 186 else 187 fputs_filtered ("\"", stream); 188 } 189 190 if (force_ellipses || i < length) 191 fputs_filtered ("...", stream); 192} 193 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. */ 197 198static struct type * 199m2_create_fundamental_type (struct objfile *objfile, int typeid) 200{ 201 struct type *type = NULL; 202 203 switch (typeid) 204 { 205 default: 206 /* FIXME: For now, if we are asked to produce a type not in this 207 language, create the equivalent of a C integer type with the 208 name "<?type?>". When all the dust settles from the type 209 reconstruction work, this should probably become an error. */ 210 type = init_type (TYPE_CODE_INT, 211 TARGET_INT_BIT / TARGET_CHAR_BIT, 212 0, "<?type?>", objfile); 213 warning ("internal error: no Modula fundamental type %d", typeid); 214 break; 215 case FT_VOID: 216 type = init_type (TYPE_CODE_VOID, 217 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 218 0, "void", objfile); 219 break; 220 case FT_BOOLEAN: 221 type = init_type (TYPE_CODE_BOOL, 222 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 223 TYPE_FLAG_UNSIGNED, "boolean", objfile); 224 break; 225 case FT_STRING: 226 type = init_type (TYPE_CODE_STRING, 227 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 228 0, "string", objfile); 229 break; 230 case FT_CHAR: 231 type = init_type (TYPE_CODE_INT, 232 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 233 0, "char", objfile); 234 break; 235 case FT_SIGNED_CHAR: 236 type = init_type (TYPE_CODE_INT, 237 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 238 0, "signed char", objfile); 239 break; 240 case FT_UNSIGNED_CHAR: 241 type = init_type (TYPE_CODE_INT, 242 TARGET_CHAR_BIT / TARGET_CHAR_BIT, 243 TYPE_FLAG_UNSIGNED, "unsigned char", objfile); 244 break; 245 case FT_SHORT: 246 type = init_type (TYPE_CODE_INT, 247 TARGET_SHORT_BIT / TARGET_CHAR_BIT, 248 0, "short", objfile); 249 break; 250 case FT_SIGNED_SHORT: 251 type = init_type (TYPE_CODE_INT, 252 TARGET_SHORT_BIT / TARGET_CHAR_BIT, 253 0, "short", objfile); /* FIXME-fnf */ 254 break; 255 case FT_UNSIGNED_SHORT: 256 type = init_type (TYPE_CODE_INT, 257 TARGET_SHORT_BIT / TARGET_CHAR_BIT, 258 TYPE_FLAG_UNSIGNED, "unsigned short", objfile); 259 break; 260 case FT_INTEGER: 261 type = init_type (TYPE_CODE_INT, 262 TARGET_INT_BIT / TARGET_CHAR_BIT, 263 0, "int", objfile); 264 break; 265 case FT_SIGNED_INTEGER: 266 type = init_type (TYPE_CODE_INT, 267 TARGET_INT_BIT / TARGET_CHAR_BIT, 268 0, "int", objfile); /* FIXME -fnf */ 269 break; 270 case FT_UNSIGNED_INTEGER: 271 type = init_type (TYPE_CODE_INT, 272 TARGET_INT_BIT / TARGET_CHAR_BIT, 273 TYPE_FLAG_UNSIGNED, "unsigned int", objfile); 274 break; 275 case FT_FIXED_DECIMAL: 276 type = init_type (TYPE_CODE_INT, 277 TARGET_INT_BIT / TARGET_CHAR_BIT, 278 0, "fixed decimal", objfile); 279 break; 280 case FT_LONG: 281 type = init_type (TYPE_CODE_INT, 282 TARGET_LONG_BIT / TARGET_CHAR_BIT, 283 0, "long", objfile); 284 break; 285 case FT_SIGNED_LONG: 286 type = init_type (TYPE_CODE_INT, 287 TARGET_LONG_BIT / TARGET_CHAR_BIT, 288 0, "long", objfile); /* FIXME -fnf */ 289 break; 290 case FT_UNSIGNED_LONG: 291 type = init_type (TYPE_CODE_INT, 292 TARGET_LONG_BIT / TARGET_CHAR_BIT, 293 TYPE_FLAG_UNSIGNED, "unsigned long", objfile); 294 break; 295 case FT_LONG_LONG: 296 type = init_type (TYPE_CODE_INT, 297 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, 298 0, "long long", objfile); 299 break; 300 case FT_SIGNED_LONG_LONG: 301 type = init_type (TYPE_CODE_INT, 302 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, 303 0, "signed long long", objfile); 304 break; 305 case FT_UNSIGNED_LONG_LONG: 306 type = init_type (TYPE_CODE_INT, 307 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, 308 TYPE_FLAG_UNSIGNED, "unsigned long long", objfile); 309 break; 310 case FT_FLOAT: 311 type = init_type (TYPE_CODE_FLT, 312 TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 313 0, "float", objfile); 314 break; 315 case FT_DBL_PREC_FLOAT: 316 type = init_type (TYPE_CODE_FLT, 317 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 318 0, "double", objfile); 319 break; 320 case FT_FLOAT_DECIMAL: 321 type = init_type (TYPE_CODE_FLT, 322 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 323 0, "floating decimal", objfile); 324 break; 325 case FT_EXT_PREC_FLOAT: 326 type = init_type (TYPE_CODE_FLT, 327 TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, 328 0, "long double", objfile); 329 break; 330 case FT_COMPLEX: 331 type = init_type (TYPE_CODE_COMPLEX, 332 2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 333 0, "complex", objfile); 334 TYPE_TARGET_TYPE (type) 335 = m2_create_fundamental_type (objfile, FT_FLOAT); 336 break; 337 case FT_DBL_PREC_COMPLEX: 338 type = init_type (TYPE_CODE_COMPLEX, 339 2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 340 0, "double complex", objfile); 341 TYPE_TARGET_TYPE (type) 342 = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT); 343 break; 344 case FT_EXT_PREC_COMPLEX: 345 type = init_type (TYPE_CODE_COMPLEX, 346 2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, 347 0, "long double complex", objfile); 348 TYPE_TARGET_TYPE (type) 349 = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT); 350 break; 351 } 352 return (type); 353} 354 355 356/* Table of operators and their precedences for printing expressions. */ 357 358static const struct op_print m2_op_print_tab[] = 359{ 360 {"+", BINOP_ADD, PREC_ADD, 0}, 361 {"+", UNOP_PLUS, PREC_PREFIX, 0}, 362 {"-", BINOP_SUB, PREC_ADD, 0}, 363 {"-", UNOP_NEG, PREC_PREFIX, 0}, 364 {"*", BINOP_MUL, PREC_MUL, 0}, 365 {"/", BINOP_DIV, PREC_MUL, 0}, 366 {"DIV", BINOP_INTDIV, PREC_MUL, 0}, 367 {"MOD", BINOP_REM, PREC_MUL, 0}, 368 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, 369 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0}, 370 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0}, 371 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, 372 {"=", BINOP_EQUAL, PREC_EQUAL, 0}, 373 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0}, 374 {"<=", BINOP_LEQ, PREC_ORDER, 0}, 375 {">=", BINOP_GEQ, PREC_ORDER, 0}, 376 {">", BINOP_GTR, PREC_ORDER, 0}, 377 {"<", BINOP_LESS, PREC_ORDER, 0}, 378 {"^", UNOP_IND, PREC_PREFIX, 0}, 379 {"@", BINOP_REPEAT, PREC_REPEAT, 0}, 380 {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0}, 381 {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0}, 382 {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0}, 383 {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0}, 384 {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0}, 385 {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0}, 386 {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0}, 387 {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0}, 388 {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0}, 389 {NULL, 0, 0, 0} 390}; 391 392/* The built-in types of Modula-2. */ 393 394struct type *builtin_type_m2_char; 395struct type *builtin_type_m2_int; 396struct type *builtin_type_m2_card; 397struct type *builtin_type_m2_real; 398struct type *builtin_type_m2_bool; 399 400struct type **const (m2_builtin_types[]) = 401{ 402 &builtin_type_m2_char, 403 &builtin_type_m2_int, 404 &builtin_type_m2_card, 405 &builtin_type_m2_real, 406 &builtin_type_m2_bool, 407 0 408}; 409 410const struct language_defn m2_language_defn = 411{ 412 "modula-2", 413 language_m2, 414 m2_builtin_types, 415 range_check_on, 416 type_check_on, 417 case_sensitive_on, 418 &exp_descriptor_standard, 419 m2_parse, /* parser */ 420 m2_error, /* parser error function */ 421 m2_printchar, /* Print character constant */ 422 m2_printstr, /* function to print string constant */ 423 m2_emit_char, /* Function to print a single character */ 424 m2_create_fundamental_type, /* Create fundamental type in this language */ 425 m2_print_type, /* Print a type using appropriate syntax */ 426 m2_val_print, /* Print a value using appropriate syntax */ 427 c_value_print, /* Print a top-level value */ 428 NULL, /* Language specific skip_trampoline */ 429 value_of_this, /* value_of_this */ 430 basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */ 431 basic_lookup_transparent_type,/* lookup_transparent_type */ 432 NULL, /* Language specific symbol demangler */ 433 {"", "", "", ""}, /* Binary format info */ 434 {"%loB", "", "o", "B"}, /* Octal format info */ 435 {"%ld", "", "d", ""}, /* Decimal format info */ 436 {"0%lXH", "0", "X", "H"}, /* Hex format info */ 437 m2_op_print_tab, /* expression operators for printing */ 438 0, /* arrays are first-class (not c-style) */ 439 0, /* String lower bound */ 440 &builtin_type_m2_char, /* Type of string elements */ 441 default_word_break_characters, 442 LANG_MAGIC 443}; 444 445/* Initialization for Modula-2 */ 446 447void 448_initialize_m2_language (void) 449{ 450 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */ 451 builtin_type_m2_int = 452 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 453 0, 454 "INTEGER", (struct objfile *) NULL); 455 builtin_type_m2_card = 456 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 457 TYPE_FLAG_UNSIGNED, 458 "CARDINAL", (struct objfile *) NULL); 459 builtin_type_m2_real = 460 init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 461 0, 462 "REAL", (struct objfile *) NULL); 463 builtin_type_m2_char = 464 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT, 465 TYPE_FLAG_UNSIGNED, 466 "CHAR", (struct objfile *) NULL); 467 builtin_type_m2_bool = 468 init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT, 469 TYPE_FLAG_UNSIGNED, 470 "BOOLEAN", (struct objfile *) NULL); 471 472 add_language (&m2_language_defn); 473} 474