GDB (xrefs)
Loading...
Searching...
No Matches
m2-lang.c
Go to the documentation of this file.
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
35struct value *
36eval_op_m2_high (struct type *expect_type, struct expression *exp,
37 enum noside noside,
38 struct value *arg1)
39{
41 return arg1;
42 else
43 {
44 arg1 = coerce_ref (arg1);
45 struct type *type = check_typedef (arg1->type ());
46
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 (arg1->type () != type)
58 arg1 = value_cast (type, arg1);
59 }
60 }
61 return arg1;
62}
63
64/* A helper function for BINOP_SUBSCRIPT. */
65
66struct value *
67eval_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 (arg1->type ());
77
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 (arg1->type () != type)
91 arg1 = value_cast (type, arg1);
92
93 check_typedef (arg1->type ());
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
107 return value::zero (type->target_type (), arg1->lval ());
108 else
109 return value_subscript (arg1, value_as_long (arg2));
110}
111
112
113
114/* Single instance of the M2 language. */
115
117
118/* See language.h. */
119
120void
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 language.h. */
143
144void
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
155void
156m2_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 unsigned int print_max_chars = get_print_max_chars (options);
173 for (i = 0; i < length && things_printed < print_max_chars; ++i)
174 {
175 /* Position of the character we are examining
176 to see whether it is repeated. */
177 unsigned int rep1;
178 /* Number of repetitions we have detected so far. */
179 unsigned int reps;
180
181 QUIT;
182
183 if (need_comma)
184 {
185 gdb_puts (", ", stream);
186 need_comma = 0;
187 }
188
189 rep1 = i + 1;
190 reps = 1;
191 while (rep1 < length && string[rep1] == string[i])
192 {
193 ++rep1;
194 ++reps;
195 }
196
197 if (reps > options->repeat_count_threshold)
198 {
199 if (in_quotes)
200 {
201 gdb_puts ("\", ", stream);
202 in_quotes = 0;
203 }
204 printchar (string[i], elttype, stream);
205 gdb_printf (stream, " <repeats %u times>", reps);
206 i = rep1 - 1;
207 things_printed += options->repeat_count_threshold;
208 need_comma = 1;
209 }
210 else
211 {
212 if (!in_quotes)
213 {
214 gdb_puts ("\"", stream);
215 in_quotes = 1;
216 }
217 emitchar (string[i], elttype, stream, '"');
218 ++things_printed;
219 }
220 }
221
222 /* Terminate the quotes if necessary. */
223 if (in_quotes)
224 gdb_puts ("\"", stream);
225
226 if (force_ellipses || i < length)
227 gdb_puts ("...", stream);
228}
229
230/* See language.h. */
231
232void
233m2_language::emitchar (int ch, struct type *chtype,
234 struct ui_file *stream, int quoter) const
235{
236 ch &= 0xFF; /* Avoid sign bit follies. */
237
238 if (PRINT_LITERAL_FORM (ch))
239 {
240 if (ch == '\\' || ch == quoter)
241 gdb_puts ("\\", stream);
242 gdb_printf (stream, "%c", ch);
243 }
244 else
245 {
246 switch (ch)
247 {
248 case '\n':
249 gdb_puts ("\\n", stream);
250 break;
251 case '\b':
252 gdb_puts ("\\b", stream);
253 break;
254 case '\t':
255 gdb_puts ("\\t", stream);
256 break;
257 case '\f':
258 gdb_puts ("\\f", stream);
259 break;
260 case '\r':
261 gdb_puts ("\\r", stream);
262 break;
263 case '\033':
264 gdb_puts ("\\e", stream);
265 break;
266 case '\007':
267 gdb_puts ("\\a", stream);
268 break;
269 default:
270 gdb_printf (stream, "\\%.3o", (unsigned int) ch);
271 break;
272 }
273 }
274}
275
276/* Called during architecture gdbarch initialisation to create language
277 specific types. */
278
279static struct builtin_m2_type *
281{
283
284 type_allocator alloc (gdbarch);
285
286 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
288 = init_integer_type (alloc, gdbarch_int_bit (gdbarch), 0, "INTEGER");
290 = init_integer_type (alloc, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
292 = init_float_type (alloc, gdbarch_float_bit (gdbarch), "REAL",
295 = init_character_type (alloc, TARGET_CHAR_BIT, 1, "CHAR");
297 = init_boolean_type (alloc, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");
298
299 return builtin_m2_type;
300}
301
303
304const struct builtin_m2_type *
306{
307 struct builtin_m2_type *result = m2_type_data.get (gdbarch);
308 if (result == nullptr)
309 {
310 result = build_m2_types (gdbarch);
311 m2_type_data.set (gdbarch, result);
312 }
313
314 return result;
315}
void emitchar(int ch, struct type *chtype, struct ui_file *stream, int quoter) const override
Definition m2-lang.c:233
void language_arch_info(struct gdbarch *gdbarch, struct language_arch_info *lai) const override
Definition m2-lang.c:121
void printchar(int ch, struct type *chtype, struct ui_file *stream) const override
Definition m2-lang.c:145
void printstr(struct ui_file *stream, struct type *elttype, const gdb_byte *string, unsigned int length, const char *encoding, int force_ellipses, const struct value_print_options *options) const override
Definition m2-lang.c:156
void set(unsigned key, void *datum)
Definition registry.h:204
void * get(unsigned key)
Definition registry.h:211
#define QUIT
Definition defs.h:187
noside
Definition expression.h:56
@ EVAL_AVOID_SIDE_EFFECTS
Definition expression.h:58
int gdbarch_int_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1449
int gdbarch_float_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1568
const struct floatformat ** gdbarch_float_format(struct gdbarch *gdbarch)
Definition gdbarch.c:1585
struct type * init_character_type(type_allocator &alloc, int bit, int unsigned_p, const char *name)
Definition gdbtypes.c:3374
struct type * init_integer_type(type_allocator &alloc, int bit, int unsigned_p, const char *name)
Definition gdbtypes.c:3355
struct type * init_float_type(type_allocator &alloc, int bit, const char *name, const struct floatformat **floatformats, enum bfd_endian byte_order)
Definition gdbtypes.c:3408
struct type * init_boolean_type(type_allocator &alloc, int bit, int unsigned_p, const char *name)
Definition gdbtypes.c:3389
struct type * check_typedef(struct type *type)
Definition gdbtypes.c:2966
#define PRINT_LITERAL_FORM(c)
Definition language.h:791
static m2_language m2_language_defn
Definition m2-lang.c:116
struct value * eval_op_m2_high(struct type *expect_type, struct expression *exp, enum noside noside, struct value *arg1)
Definition m2-lang.c:36
struct value * eval_op_m2_subscript(struct type *expect_type, struct expression *exp, enum noside noside, struct value *arg1, struct value *arg2)
Definition m2-lang.c:67
static const registry< gdbarch >::key< struct builtin_m2_type > m2_type_data
Definition m2-lang.c:302
const struct builtin_m2_type * builtin_m2_type(struct gdbarch *gdbarch)
Definition m2-lang.c:305
static struct builtin_m2_type * build_m2_types(struct gdbarch *gdbarch)
Definition m2-lang.c:280
int m2_is_unbounded_array(struct type *type)
const struct builtin_m2_type * builtin_m2_type(struct gdbarch *gdbarch)
Definition m2-lang.c:305
enum var_types type
Definition scm-param.c:142
struct type * builtin_real
Definition m2-lang.h:43
struct type * builtin_char
Definition m2-lang.h:40
struct type * builtin_bool
Definition m2-lang.h:44
struct type * builtin_card
Definition m2-lang.h:42
struct type * builtin_int
Definition m2-lang.h:41
struct type * type() const
Definition gdbtypes.h:547
void set_string_char_type(struct type *type)
Definition language.h:114
void add_primitive_type(struct type *type)
Definition language.h:130
void set_bool_type(struct type *type, const char *name=nullptr)
Definition language.h:102
struct type * target_type() const
Definition gdbtypes.h:1037
type_code code() const
Definition gdbtypes.h:956
ULONGEST length() const
Definition gdbtypes.h:983
struct field & field(int idx) const
Definition gdbtypes.h:1012
const char * name() const
Definition gdbtypes.h:968
unsigned int repeat_count_threshold
Definition valprint.h:76
Definition value.h:130
static struct value * zero(struct type *type, enum lval_type lv)
Definition value.c:3426
struct type * type() const
Definition value.h:180
enum lval_type lval() const
Definition value.h:332
void gdb_printf(struct ui_file *stream, const char *format,...)
Definition utils.c:1886
void gdb_puts(const char *linebuffer, struct ui_file *stream)
Definition utils.c:1809
struct value * value_subscript(struct value *array, LONGEST index)
Definition valarith.c:141
struct value * value_ptradd(struct value *arg1, LONGEST arg2)
Definition valarith.c:79
struct value * value_struct_elt(struct value **argp, gdb::optional< gdb::array_view< value * > > args, const char *name, int *static_memfuncp, const char *err)
Definition valops.c:2334
struct value * value_cast(struct type *type, struct value *arg2)
Definition valops.c:403
struct value * value_ind(struct value *arg1)
Definition valops.c:1630
static unsigned int get_print_max_chars(const struct value_print_options *options)
Definition valprint.h:131
struct value * coerce_ref(struct value *arg)
Definition value.c:3752
LONGEST value_as_long(struct value *val)
Definition value.c:2554