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