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