1 /* Modula 2 language support routines for GDB, the GNU debugger. 2 3 Copyright (C) 1992-2023 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 "varobj.h" 27 #include "m2-lang.h" 28 #include "c-lang.h" 29 #include "valprint.h" 30 #include "gdbarch.h" 31 #include "m2-exp.h" 32 33 /* A helper function for UNOP_HIGH. */ 34 35 struct value * 36 eval_op_m2_high (struct type *expect_type, struct expression *exp, 37 enum noside noside, 38 struct value *arg1) 39 { 40 if (noside == EVAL_AVOID_SIDE_EFFECTS) 41 return arg1; 42 else 43 { 44 arg1 = coerce_ref (arg1); 45 struct type *type = check_typedef (value_type (arg1)); 46 47 if (m2_is_unbounded_array (type)) 48 { 49 struct value *temp = arg1; 50 51 type = type->field (1).type (); 52 /* i18n: Do not translate the "_m2_high" part! */ 53 arg1 = value_struct_elt (&temp, {}, "_m2_high", NULL, 54 _("unbounded structure " 55 "missing _m2_high field")); 56 57 if (value_type (arg1) != type) 58 arg1 = value_cast (type, arg1); 59 } 60 } 61 return arg1; 62 } 63 64 /* A helper function for BINOP_SUBSCRIPT. */ 65 66 struct value * 67 eval_op_m2_subscript (struct type *expect_type, struct expression *exp, 68 enum noside noside, 69 struct value *arg1, struct value *arg2) 70 { 71 /* If the user attempts to subscript something that is not an 72 array or pointer type (like a plain int variable for example), 73 then report this as an error. */ 74 75 arg1 = coerce_ref (arg1); 76 struct type *type = check_typedef (value_type (arg1)); 77 78 if (m2_is_unbounded_array (type)) 79 { 80 struct value *temp = arg1; 81 type = type->field (0).type (); 82 if (type == NULL || (type->code () != TYPE_CODE_PTR)) 83 error (_("internal error: unbounded " 84 "array structure is unknown")); 85 /* i18n: Do not translate the "_m2_contents" part! */ 86 arg1 = value_struct_elt (&temp, {}, "_m2_contents", NULL, 87 _("unbounded structure " 88 "missing _m2_contents field")); 89 90 if (value_type (arg1) != type) 91 arg1 = value_cast (type, arg1); 92 93 check_typedef (value_type (arg1)); 94 return value_ind (value_ptradd (arg1, value_as_long (arg2))); 95 } 96 else 97 if (type->code () != TYPE_CODE_ARRAY) 98 { 99 if (type->name ()) 100 error (_("cannot subscript something of type `%s'"), 101 type->name ()); 102 else 103 error (_("cannot subscript requested type")); 104 } 105 106 if (noside == EVAL_AVOID_SIDE_EFFECTS) 107 return value_zero (type->target_type (), VALUE_LVAL (arg1)); 108 else 109 return value_subscript (arg1, value_as_long (arg2)); 110 } 111 112 113 114 /* Single instance of the M2 language. */ 115 116 static m2_language m2_language_defn; 117 118 /* See language.h. */ 119 120 void 121 m2_language::language_arch_info (struct gdbarch *gdbarch, 122 struct language_arch_info *lai) const 123 { 124 const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch); 125 126 /* Helper function to allow shorter lines below. */ 127 auto add = [&] (struct type * t) 128 { 129 lai->add_primitive_type (t); 130 }; 131 132 add (builtin->builtin_char); 133 add (builtin->builtin_int); 134 add (builtin->builtin_card); 135 add (builtin->builtin_real); 136 add (builtin->builtin_bool); 137 138 lai->set_string_char_type (builtin->builtin_char); 139 lai->set_bool_type (builtin->builtin_bool, "BOOLEAN"); 140 } 141 142 /* See languge.h. */ 143 144 void 145 m2_language::printchar (int c, struct type *type, 146 struct ui_file *stream) const 147 { 148 gdb_puts ("'", stream); 149 emitchar (c, type, stream, '\''); 150 gdb_puts ("'", stream); 151 } 152 153 /* See language.h. */ 154 155 void 156 m2_language::printstr (struct ui_file *stream, struct type *elttype, 157 const gdb_byte *string, unsigned int length, 158 const char *encoding, int force_ellipses, 159 const struct value_print_options *options) const 160 { 161 unsigned int i; 162 unsigned int things_printed = 0; 163 int in_quotes = 0; 164 int need_comma = 0; 165 166 if (length == 0) 167 { 168 gdb_puts ("\"\""); 169 return; 170 } 171 172 for (i = 0; i < length && things_printed < options->print_max; ++i) 173 { 174 /* Position of the character we are examining 175 to see whether it is repeated. */ 176 unsigned int rep1; 177 /* Number of repetitions we have detected so far. */ 178 unsigned int reps; 179 180 QUIT; 181 182 if (need_comma) 183 { 184 gdb_puts (", ", stream); 185 need_comma = 0; 186 } 187 188 rep1 = i + 1; 189 reps = 1; 190 while (rep1 < length && string[rep1] == string[i]) 191 { 192 ++rep1; 193 ++reps; 194 } 195 196 if (reps > options->repeat_count_threshold) 197 { 198 if (in_quotes) 199 { 200 gdb_puts ("\", ", stream); 201 in_quotes = 0; 202 } 203 printchar (string[i], elttype, stream); 204 gdb_printf (stream, " <repeats %u times>", reps); 205 i = rep1 - 1; 206 things_printed += options->repeat_count_threshold; 207 need_comma = 1; 208 } 209 else 210 { 211 if (!in_quotes) 212 { 213 gdb_puts ("\"", stream); 214 in_quotes = 1; 215 } 216 emitchar (string[i], elttype, stream, '"'); 217 ++things_printed; 218 } 219 } 220 221 /* Terminate the quotes if necessary. */ 222 if (in_quotes) 223 gdb_puts ("\"", stream); 224 225 if (force_ellipses || i < length) 226 gdb_puts ("...", stream); 227 } 228 229 /* See language.h. */ 230 231 void 232 m2_language::emitchar (int ch, struct type *chtype, 233 struct ui_file *stream, int quoter) const 234 { 235 ch &= 0xFF; /* Avoid sign bit follies. */ 236 237 if (PRINT_LITERAL_FORM (ch)) 238 { 239 if (ch == '\\' || ch == quoter) 240 gdb_puts ("\\", stream); 241 gdb_printf (stream, "%c", ch); 242 } 243 else 244 { 245 switch (ch) 246 { 247 case '\n': 248 gdb_puts ("\\n", stream); 249 break; 250 case '\b': 251 gdb_puts ("\\b", stream); 252 break; 253 case '\t': 254 gdb_puts ("\\t", stream); 255 break; 256 case '\f': 257 gdb_puts ("\\f", stream); 258 break; 259 case '\r': 260 gdb_puts ("\\r", stream); 261 break; 262 case '\033': 263 gdb_puts ("\\e", stream); 264 break; 265 case '\007': 266 gdb_puts ("\\a", stream); 267 break; 268 default: 269 gdb_printf (stream, "\\%.3o", (unsigned int) ch); 270 break; 271 } 272 } 273 } 274 275 /* Called during architecture gdbarch initialisation to create language 276 specific types. */ 277 278 static struct builtin_m2_type * 279 build_m2_types (struct gdbarch *gdbarch) 280 { 281 struct builtin_m2_type *builtin_m2_type = new struct builtin_m2_type; 282 283 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */ 284 builtin_m2_type->builtin_int 285 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER"); 286 builtin_m2_type->builtin_card 287 = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL"); 288 builtin_m2_type->builtin_real 289 = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", 290 gdbarch_float_format (gdbarch)); 291 builtin_m2_type->builtin_char 292 = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR"); 293 builtin_m2_type->builtin_bool 294 = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN"); 295 296 return builtin_m2_type; 297 } 298 299 static const registry<gdbarch>::key<struct builtin_m2_type> m2_type_data; 300 301 const struct builtin_m2_type * 302 builtin_m2_type (struct gdbarch *gdbarch) 303 { 304 struct builtin_m2_type *result = m2_type_data.get (gdbarch); 305 if (result == nullptr) 306 { 307 result = build_m2_types (gdbarch); 308 m2_type_data.set (gdbarch, result); 309 } 310 311 return result; 312 } 313