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