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, 2008, 2009, 2010 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 31 extern void _initialize_m2_language (void); 32 static void m2_printchar (int, struct type *, struct ui_file *); 33 static void m2_emit_char (int, struct type *, struct ui_file *, int); 34 35 /* Print the character C on STREAM as part of the contents of a literal 36 string whose delimiter is QUOTER. Note that that format for printing 37 characters and strings is language specific. 38 FIXME: This is a copy of the same function from c-exp.y. It should 39 be replaced with a true Modula version. */ 40 41 static void 42 m2_emit_char (int c, struct type *type, struct ui_file *stream, int quoter) 43 { 44 45 c &= 0xFF; /* Avoid sign bit follies */ 46 47 if (PRINT_LITERAL_FORM (c)) 48 { 49 if (c == '\\' || c == quoter) 50 { 51 fputs_filtered ("\\", stream); 52 } 53 fprintf_filtered (stream, "%c", c); 54 } 55 else 56 { 57 switch (c) 58 { 59 case '\n': 60 fputs_filtered ("\\n", stream); 61 break; 62 case '\b': 63 fputs_filtered ("\\b", stream); 64 break; 65 case '\t': 66 fputs_filtered ("\\t", stream); 67 break; 68 case '\f': 69 fputs_filtered ("\\f", stream); 70 break; 71 case '\r': 72 fputs_filtered ("\\r", stream); 73 break; 74 case '\033': 75 fputs_filtered ("\\e", stream); 76 break; 77 case '\007': 78 fputs_filtered ("\\a", stream); 79 break; 80 default: 81 fprintf_filtered (stream, "\\%.3o", (unsigned int) c); 82 break; 83 } 84 } 85 } 86 87 /* FIXME: This is a copy of the same function from c-exp.y. It should 88 be replaced with a true Modula version. */ 89 90 static void 91 m2_printchar (int c, struct type *type, struct ui_file *stream) 92 { 93 fputs_filtered ("'", stream); 94 LA_EMIT_CHAR (c, type, stream, '\''); 95 fputs_filtered ("'", stream); 96 } 97 98 /* Print the character string STRING, printing at most LENGTH characters. 99 Printing stops early if the number hits print_max; repeat counts 100 are printed as appropriate. Print ellipses at the end if we 101 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. 102 FIXME: This is a copy of the same function from c-exp.y. It should 103 be replaced with a true Modula version. */ 104 105 static void 106 m2_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string, 107 unsigned int length, const char *encoding, int force_ellipses, 108 const struct value_print_options *options) 109 { 110 unsigned int i; 111 unsigned int things_printed = 0; 112 int in_quotes = 0; 113 int need_comma = 0; 114 115 if (length == 0) 116 { 117 fputs_filtered ("\"\"", gdb_stdout); 118 return; 119 } 120 121 for (i = 0; i < length && things_printed < options->print_max; ++i) 122 { 123 /* Position of the character we are examining 124 to see whether it is repeated. */ 125 unsigned int rep1; 126 /* Number of repetitions we have detected so far. */ 127 unsigned int reps; 128 129 QUIT; 130 131 if (need_comma) 132 { 133 fputs_filtered (", ", stream); 134 need_comma = 0; 135 } 136 137 rep1 = i + 1; 138 reps = 1; 139 while (rep1 < length && string[rep1] == string[i]) 140 { 141 ++rep1; 142 ++reps; 143 } 144 145 if (reps > options->repeat_count_threshold) 146 { 147 if (in_quotes) 148 { 149 if (options->inspect_it) 150 fputs_filtered ("\\\", ", stream); 151 else 152 fputs_filtered ("\", ", stream); 153 in_quotes = 0; 154 } 155 m2_printchar (string[i], type, stream); 156 fprintf_filtered (stream, " <repeats %u times>", reps); 157 i = rep1 - 1; 158 things_printed += options->repeat_count_threshold; 159 need_comma = 1; 160 } 161 else 162 { 163 if (!in_quotes) 164 { 165 if (options->inspect_it) 166 fputs_filtered ("\\\"", stream); 167 else 168 fputs_filtered ("\"", stream); 169 in_quotes = 1; 170 } 171 LA_EMIT_CHAR (string[i], type, stream, '"'); 172 ++things_printed; 173 } 174 } 175 176 /* Terminate the quotes if necessary. */ 177 if (in_quotes) 178 { 179 if (options->inspect_it) 180 fputs_filtered ("\\\"", stream); 181 else 182 fputs_filtered ("\"", stream); 183 } 184 185 if (force_ellipses || i < length) 186 fputs_filtered ("...", stream); 187 } 188 189 static struct value * 190 evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp, 191 int *pos, enum noside noside) 192 { 193 enum exp_opcode op = exp->elts[*pos].opcode; 194 struct value *arg1; 195 struct value *arg2; 196 struct type *type; 197 198 switch (op) 199 { 200 case UNOP_HIGH: 201 (*pos)++; 202 arg1 = evaluate_subexp_with_coercion (exp, pos, noside); 203 204 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS) 205 return arg1; 206 else 207 { 208 arg1 = coerce_ref (arg1); 209 type = check_typedef (value_type (arg1)); 210 211 if (m2_is_unbounded_array (type)) 212 { 213 struct value *temp = arg1; 214 215 type = TYPE_FIELD_TYPE (type, 1); 216 /* i18n: Do not translate the "_m2_high" part! */ 217 arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL, 218 _("unbounded structure " 219 "missing _m2_high field")); 220 221 if (value_type (arg1) != type) 222 arg1 = value_cast (type, arg1); 223 } 224 } 225 return arg1; 226 227 case BINOP_SUBSCRIPT: 228 (*pos)++; 229 arg1 = evaluate_subexp_with_coercion (exp, pos, noside); 230 arg2 = evaluate_subexp_with_coercion (exp, pos, noside); 231 if (noside == EVAL_SKIP) 232 goto nosideret; 233 /* If the user attempts to subscript something that is not an 234 array or pointer type (like a plain int variable for example), 235 then report this as an error. */ 236 237 arg1 = coerce_ref (arg1); 238 type = check_typedef (value_type (arg1)); 239 240 if (m2_is_unbounded_array (type)) 241 { 242 struct value *temp = arg1; 243 type = TYPE_FIELD_TYPE (type, 0); 244 if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR)) 245 { 246 warning (_("internal error: unbounded array structure is unknown")); 247 return evaluate_subexp_standard (expect_type, exp, pos, noside); 248 } 249 /* i18n: Do not translate the "_m2_contents" part! */ 250 arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL, 251 _("unbounded structure " 252 "missing _m2_contents field")); 253 254 if (value_type (arg1) != type) 255 arg1 = value_cast (type, arg1); 256 257 type = check_typedef (value_type (arg1)); 258 return value_ind (value_ptradd (arg1, value_as_long (arg2))); 259 } 260 else 261 if (TYPE_CODE (type) != TYPE_CODE_ARRAY) 262 { 263 if (TYPE_NAME (type)) 264 error (_("cannot subscript something of type `%s'"), 265 TYPE_NAME (type)); 266 else 267 error (_("cannot subscript requested type")); 268 } 269 270 if (noside == EVAL_AVOID_SIDE_EFFECTS) 271 return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1)); 272 else 273 return value_subscript (arg1, value_as_long (arg2)); 274 275 default: 276 return evaluate_subexp_standard (expect_type, exp, pos, noside); 277 } 278 279 nosideret: 280 return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1); 281 } 282 283 284 /* Table of operators and their precedences for printing expressions. */ 285 286 static const struct op_print m2_op_print_tab[] = 287 { 288 {"+", BINOP_ADD, PREC_ADD, 0}, 289 {"+", UNOP_PLUS, PREC_PREFIX, 0}, 290 {"-", BINOP_SUB, PREC_ADD, 0}, 291 {"-", UNOP_NEG, PREC_PREFIX, 0}, 292 {"*", BINOP_MUL, PREC_MUL, 0}, 293 {"/", BINOP_DIV, PREC_MUL, 0}, 294 {"DIV", BINOP_INTDIV, PREC_MUL, 0}, 295 {"MOD", BINOP_REM, PREC_MUL, 0}, 296 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, 297 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0}, 298 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0}, 299 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, 300 {"=", BINOP_EQUAL, PREC_EQUAL, 0}, 301 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0}, 302 {"<=", BINOP_LEQ, PREC_ORDER, 0}, 303 {">=", BINOP_GEQ, PREC_ORDER, 0}, 304 {">", BINOP_GTR, PREC_ORDER, 0}, 305 {"<", BINOP_LESS, PREC_ORDER, 0}, 306 {"^", UNOP_IND, PREC_PREFIX, 0}, 307 {"@", BINOP_REPEAT, PREC_REPEAT, 0}, 308 {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0}, 309 {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0}, 310 {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0}, 311 {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0}, 312 {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0}, 313 {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0}, 314 {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0}, 315 {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0}, 316 {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0}, 317 {NULL, 0, 0, 0} 318 }; 319 320 /* The built-in types of Modula-2. */ 321 322 enum m2_primitive_types { 323 m2_primitive_type_char, 324 m2_primitive_type_int, 325 m2_primitive_type_card, 326 m2_primitive_type_real, 327 m2_primitive_type_bool, 328 nr_m2_primitive_types 329 }; 330 331 static void 332 m2_language_arch_info (struct gdbarch *gdbarch, 333 struct language_arch_info *lai) 334 { 335 const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch); 336 337 lai->string_char_type = builtin->builtin_char; 338 lai->primitive_type_vector 339 = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1, 340 struct type *); 341 342 lai->primitive_type_vector [m2_primitive_type_char] 343 = builtin->builtin_char; 344 lai->primitive_type_vector [m2_primitive_type_int] 345 = builtin->builtin_int; 346 lai->primitive_type_vector [m2_primitive_type_card] 347 = builtin->builtin_card; 348 lai->primitive_type_vector [m2_primitive_type_real] 349 = builtin->builtin_real; 350 lai->primitive_type_vector [m2_primitive_type_bool] 351 = builtin->builtin_bool; 352 353 lai->bool_type_symbol = "BOOLEAN"; 354 lai->bool_type_default = builtin->builtin_bool; 355 } 356 357 const struct exp_descriptor exp_descriptor_modula2 = 358 { 359 print_subexp_standard, 360 operator_length_standard, 361 operator_check_standard, 362 op_name_standard, 363 dump_subexp_body_standard, 364 evaluate_subexp_modula2 365 }; 366 367 const struct language_defn m2_language_defn = 368 { 369 "modula-2", 370 language_m2, 371 range_check_on, 372 type_check_on, 373 case_sensitive_on, 374 array_row_major, 375 macro_expansion_no, 376 &exp_descriptor_modula2, 377 m2_parse, /* parser */ 378 m2_error, /* parser error function */ 379 null_post_parser, 380 m2_printchar, /* Print character constant */ 381 m2_printstr, /* function to print string constant */ 382 m2_emit_char, /* Function to print a single character */ 383 m2_print_type, /* Print a type using appropriate syntax */ 384 m2_print_typedef, /* Print a typedef using appropriate syntax */ 385 m2_val_print, /* Print a value using appropriate syntax */ 386 c_value_print, /* Print a top-level value */ 387 NULL, /* Language specific skip_trampoline */ 388 NULL, /* name_of_this */ 389 basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */ 390 basic_lookup_transparent_type,/* lookup_transparent_type */ 391 NULL, /* Language specific symbol demangler */ 392 NULL, /* Language specific class_name_from_physname */ 393 m2_op_print_tab, /* expression operators for printing */ 394 0, /* arrays are first-class (not c-style) */ 395 0, /* String lower bound */ 396 default_word_break_characters, 397 default_make_symbol_completion_list, 398 m2_language_arch_info, 399 default_print_array_index, 400 default_pass_by_reference, 401 default_get_string, 402 LANG_MAGIC 403 }; 404 405 static void * 406 build_m2_types (struct gdbarch *gdbarch) 407 { 408 struct builtin_m2_type *builtin_m2_type 409 = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type); 410 411 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */ 412 builtin_m2_type->builtin_int 413 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER"); 414 builtin_m2_type->builtin_card 415 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL"); 416 builtin_m2_type->builtin_real 417 = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", NULL); 418 builtin_m2_type->builtin_char 419 = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR"); 420 builtin_m2_type->builtin_bool 421 = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN"); 422 423 return builtin_m2_type; 424 } 425 426 static struct gdbarch_data *m2_type_data; 427 428 const struct builtin_m2_type * 429 builtin_m2_type (struct gdbarch *gdbarch) 430 { 431 return gdbarch_data (gdbarch, m2_type_data); 432 } 433 434 435 /* Initialization for Modula-2 */ 436 437 void 438 _initialize_m2_language (void) 439 { 440 m2_type_data = gdbarch_data_register_post_init (build_m2_types); 441 442 add_language (&m2_language_defn); 443 } 444