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   &exp_descriptor_standard,
419   m2_parse,			/* parser */
420   m2_error,			/* parser error function */
421   null_post_parser,
422   m2_printchar,			/* Print character constant */
423   m2_printstr,			/* function to print string constant */
424   m2_emit_char,			/* Function to print a single character */
425   m2_create_fundamental_type,	/* Create fundamental type in this language */
426   m2_print_type,		/* Print a type using appropriate syntax */
427   m2_val_print,			/* Print a value using appropriate syntax */
428   c_value_print,		/* Print a top-level value */
429   NULL,				/* Language specific skip_trampoline */
430   value_of_this,		/* value_of_this */
431   basic_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal */
432   basic_lookup_transparent_type,/* lookup_transparent_type */
433   NULL,				/* Language specific symbol demangler */
434   NULL,				/* Language specific class_name_from_physname */
435   {"", "", "", ""},		/* Binary format info */
436   {"%loB", "", "o", "B"},	/* Octal format info */
437   {"%ld", "", "d", ""},		/* Decimal format info */
438   {"0%lXH", "0", "X", "H"},	/* Hex format info */
439   m2_op_print_tab,		/* expression operators for printing */
440   0,				/* arrays are first-class (not c-style) */
441   0,				/* String lower bound */
442   &builtin_type_m2_char,	/* Type of string elements */
443   default_word_break_characters,
444   LANG_MAGIC
445 };
446 
447 /* Initialization for Modula-2 */
448 
449 void
_initialize_m2_language(void)450 _initialize_m2_language (void)
451 {
452   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
453   builtin_type_m2_int =
454     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
455 	       0,
456 	       "INTEGER", (struct objfile *) NULL);
457   builtin_type_m2_card =
458     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
459 	       TYPE_FLAG_UNSIGNED,
460 	       "CARDINAL", (struct objfile *) NULL);
461   builtin_type_m2_real =
462     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
463 	       0,
464 	       "REAL", (struct objfile *) NULL);
465   builtin_type_m2_char =
466     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
467 	       TYPE_FLAG_UNSIGNED,
468 	       "CHAR", (struct objfile *) NULL);
469   builtin_type_m2_bool =
470     init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
471 	       TYPE_FLAG_UNSIGNED,
472 	       "BOOLEAN", (struct objfile *) NULL);
473 
474   add_language (&m2_language_defn);
475 }
476