2005-05-09 Andrew Cagney <cagney@gnu.org>
[external/binutils.git] / gdb / m2-lang.c
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
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
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
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 *
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 \f
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 \f
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
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 }