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