This commit was generated by cvs2svn to track changes on a CVS vendor
[external/binutils.git] / gdb / language.c
1 /* Multiple source language support for GDB.
2    Copyright 1991, 1992, 2000 Free Software Foundation, Inc.
3    Contributed by the Department of Computer Science at the State University
4    of New York at Buffalo.
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 /* This file contains functions that return things that are specific
24    to languages.  Each function should examine current_language if necessary,
25    and return the appropriate result. */
26
27 /* FIXME:  Most of these would be better organized as macros which
28    return data out of a "language-specific" struct pointer that is set
29    whenever the working language changes.  That would be a lot faster.  */
30
31 #include "defs.h"
32 #include <ctype.h>
33 #include "gdb_string.h"
34
35 #include "symtab.h"
36 #include "gdbtypes.h"
37 #include "value.h"
38 #include "gdbcmd.h"
39 #include "frame.h"
40 #include "expression.h"
41 #include "language.h"
42 #include "target.h"
43 #include "parser-defs.h"
44
45 extern void _initialize_language PARAMS ((void));
46
47 static void
48 show_language_command PARAMS ((char *, int));
49
50 static void
51 set_language_command PARAMS ((char *, int));
52
53 static void
54 show_type_command PARAMS ((char *, int));
55
56 static void
57 set_type_command PARAMS ((char *, int));
58
59 static void
60 show_range_command PARAMS ((char *, int));
61
62 static void
63 set_range_command PARAMS ((char *, int));
64
65 static void
66 set_range_str PARAMS ((void));
67
68 static void
69 set_type_str PARAMS ((void));
70
71 static void
72 set_lang_str PARAMS ((void));
73
74 static void
75 unk_lang_error PARAMS ((char *));
76
77 static int
78 unk_lang_parser PARAMS ((void));
79
80 static void
81 show_check PARAMS ((char *, int));
82
83 static void
84 set_check PARAMS ((char *, int));
85
86 static void
87 set_type_range PARAMS ((void));
88
89 static void unk_lang_emit_char (int c, struct ui_file *stream, int quoter);
90
91 static void unk_lang_printchar (int c, struct ui_file *stream);
92
93 static void unk_lang_printstr (struct ui_file * stream, char *string,
94                                unsigned int length, int width,
95                                int force_ellipses);
96
97 static struct type *
98   unk_lang_create_fundamental_type PARAMS ((struct objfile *, int));
99
100 static void unk_lang_print_type (struct type *, char *, struct ui_file *,
101                                  int, int);
102
103 static int unk_lang_val_print (struct type *, char *, int, CORE_ADDR,
104                                struct ui_file *, int, int, int,
105                                enum val_prettyprint);
106
107 static int unk_lang_value_print (value_ptr, struct ui_file *, int, enum val_prettyprint);
108
109 /* Forward declaration */
110 extern const struct language_defn unknown_language_defn;
111 extern char *warning_pre_print;
112
113 /* The current (default at startup) state of type and range checking.
114    (If the modes are set to "auto", though, these are changed based
115    on the default language at startup, and then again based on the
116    language of the first source file.  */
117
118 enum range_mode range_mode = range_mode_auto;
119 enum range_check range_check = range_check_off;
120 enum type_mode type_mode = type_mode_auto;
121 enum type_check type_check = type_check_off;
122
123 /* The current language and language_mode (see language.h) */
124
125 const struct language_defn *current_language = &unknown_language_defn;
126 enum language_mode language_mode = language_mode_auto;
127
128 /* The language that the user expects to be typing in (the language
129    of main(), or the last language we notified them about, or C).  */
130
131 const struct language_defn *expected_language;
132
133 /* The list of supported languages.  The list itself is malloc'd.  */
134
135 static const struct language_defn **languages;
136 static unsigned languages_size;
137 static unsigned languages_allocsize;
138 #define DEFAULT_ALLOCSIZE 4
139
140 /* The "set language/type/range" commands all put stuff in these
141    buffers.  This is to make them work as set/show commands.  The
142    user's string is copied here, then the set_* commands look at
143    them and update them to something that looks nice when it is
144    printed out. */
145
146 static char *language;
147 static char *type;
148 static char *range;
149
150 /* Warning issued when current_language and the language of the current
151    frame do not match. */
152 char lang_frame_mismatch_warn[] =
153 "Warning: the current language does not match this frame.";
154 \f
155
156 /* This page contains the functions corresponding to GDB commands
157    and their helpers. */
158
159 /* Show command.  Display a warning if the language set
160    does not match the frame. */
161 static void
162 show_language_command (ignore, from_tty)
163      char *ignore;
164      int from_tty;
165 {
166   enum language flang;          /* The language of the current frame */
167
168   flang = get_frame_language ();
169   if (flang != language_unknown &&
170       language_mode == language_mode_manual &&
171       current_language->la_language != flang)
172     printf_filtered ("%s\n", lang_frame_mismatch_warn);
173 }
174
175 /* Set command.  Change the current working language. */
176 static void
177 set_language_command (ignore, from_tty)
178      char *ignore;
179      int from_tty;
180 {
181   int i;
182   enum language flang;
183   char *err_lang;
184
185   if (!language || !language[0])
186     {
187       printf_unfiltered ("The currently understood settings are:\n\n");
188       printf_unfiltered ("local or auto    Automatic setting based on source file\n");
189
190       for (i = 0; i < languages_size; ++i)
191         {
192           /* Already dealt with these above.  */
193           if (languages[i]->la_language == language_unknown
194               || languages[i]->la_language == language_auto)
195             continue;
196
197           /* FIXME for now assume that the human-readable name is just
198              a capitalization of the internal name.  */
199           printf_unfiltered ("%-16s Use the %c%s language\n",
200                              languages[i]->la_name,
201           /* Capitalize first letter of language
202              name.  */
203                              toupper (languages[i]->la_name[0]),
204                              languages[i]->la_name + 1);
205         }
206       /* Restore the silly string. */
207       set_language (current_language->la_language);
208       return;
209     }
210
211   /* Search the list of languages for a match.  */
212   for (i = 0; i < languages_size; i++)
213     {
214       if (STREQ (languages[i]->la_name, language))
215         {
216           /* Found it!  Go into manual mode, and use this language.  */
217           if (languages[i]->la_language == language_auto)
218             {
219               /* Enter auto mode.  Set to the current frame's language, if known.  */
220               language_mode = language_mode_auto;
221               flang = get_frame_language ();
222               if (flang != language_unknown)
223                 set_language (flang);
224               expected_language = current_language;
225               return;
226             }
227           else
228             {
229               /* Enter manual mode.  Set the specified language.  */
230               language_mode = language_mode_manual;
231               current_language = languages[i];
232               set_type_range ();
233               set_lang_str ();
234               expected_language = current_language;
235               return;
236             }
237         }
238     }
239
240   /* Reset the language (esp. the global string "language") to the 
241      correct values. */
242   err_lang = savestring (language, strlen (language));
243   make_cleanup (free, err_lang);        /* Free it after error */
244   set_language (current_language->la_language);
245   error ("Unknown language `%s'.", err_lang);
246 }
247
248 /* Show command.  Display a warning if the type setting does
249    not match the current language. */
250 static void
251 show_type_command (ignore, from_tty)
252      char *ignore;
253      int from_tty;
254 {
255   if (type_check != current_language->la_type_check)
256     printf_unfiltered (
257                         "Warning: the current type check setting does not match the language.\n");
258 }
259
260 /* Set command.  Change the setting for type checking. */
261 static void
262 set_type_command (ignore, from_tty)
263      char *ignore;
264      int from_tty;
265 {
266   if (STREQ (type, "on"))
267     {
268       type_check = type_check_on;
269       type_mode = type_mode_manual;
270     }
271   else if (STREQ (type, "warn"))
272     {
273       type_check = type_check_warn;
274       type_mode = type_mode_manual;
275     }
276   else if (STREQ (type, "off"))
277     {
278       type_check = type_check_off;
279       type_mode = type_mode_manual;
280     }
281   else if (STREQ (type, "auto"))
282     {
283       type_mode = type_mode_auto;
284       set_type_range ();
285       /* Avoid hitting the set_type_str call below.  We
286          did it in set_type_range. */
287       return;
288     }
289   else
290     {
291       warning ("Unrecognized type check setting: \"%s\"", type);
292     }
293   set_type_str ();
294   show_type_command ((char *) NULL, from_tty);
295 }
296
297 /* Show command.  Display a warning if the range setting does
298    not match the current language. */
299 static void
300 show_range_command (ignore, from_tty)
301      char *ignore;
302      int from_tty;
303 {
304
305   if (range_check != current_language->la_range_check)
306     printf_unfiltered (
307                         "Warning: the current range check setting does not match the language.\n");
308 }
309
310 /* Set command.  Change the setting for range checking. */
311 static void
312 set_range_command (ignore, from_tty)
313      char *ignore;
314      int from_tty;
315 {
316   if (STREQ (range, "on"))
317     {
318       range_check = range_check_on;
319       range_mode = range_mode_manual;
320     }
321   else if (STREQ (range, "warn"))
322     {
323       range_check = range_check_warn;
324       range_mode = range_mode_manual;
325     }
326   else if (STREQ (range, "off"))
327     {
328       range_check = range_check_off;
329       range_mode = range_mode_manual;
330     }
331   else if (STREQ (range, "auto"))
332     {
333       range_mode = range_mode_auto;
334       set_type_range ();
335       /* Avoid hitting the set_range_str call below.  We
336          did it in set_type_range. */
337       return;
338     }
339   else
340     {
341       warning ("Unrecognized range check setting: \"%s\"", range);
342     }
343   set_range_str ();
344   show_range_command ((char *) 0, from_tty);
345 }
346
347 /* Set the status of range and type checking based on
348    the current modes and the current language.
349    If SHOW is non-zero, then print out the current language,
350    type and range checking status. */
351 static void
352 set_type_range ()
353 {
354
355   if (range_mode == range_mode_auto)
356     range_check = current_language->la_range_check;
357
358   if (type_mode == type_mode_auto)
359     type_check = current_language->la_type_check;
360
361   set_type_str ();
362   set_range_str ();
363 }
364
365 /* Set current language to (enum language) LANG.  Returns previous language. */
366
367 enum language
368 set_language (lang)
369      enum language lang;
370 {
371   int i;
372   enum language prev_language;
373
374   prev_language = current_language->la_language;
375
376   for (i = 0; i < languages_size; i++)
377     {
378       if (languages[i]->la_language == lang)
379         {
380           current_language = languages[i];
381           set_type_range ();
382           set_lang_str ();
383           break;
384         }
385     }
386
387   return prev_language;
388 }
389 \f
390 /* This page contains functions that update the global vars
391    language, type and range. */
392 static void
393 set_lang_str ()
394 {
395   char *prefix = "";
396
397   free (language);
398   if (language_mode == language_mode_auto)
399     prefix = "auto; currently ";
400
401   language = concat (prefix, current_language->la_name, NULL);
402 }
403
404 static void
405 set_type_str ()
406 {
407   char *tmp = NULL, *prefix = "";
408
409   free (type);
410   if (type_mode == type_mode_auto)
411     prefix = "auto; currently ";
412
413   switch (type_check)
414     {
415     case type_check_on:
416       tmp = "on";
417       break;
418     case type_check_off:
419       tmp = "off";
420       break;
421     case type_check_warn:
422       tmp = "warn";
423       break;
424     default:
425       error ("Unrecognized type check setting.");
426     }
427
428   type = concat (prefix, tmp, NULL);
429 }
430
431 static void
432 set_range_str ()
433 {
434   char *tmp, *pref = "";
435
436   if (range_mode == range_mode_auto)
437     pref = "auto; currently ";
438
439   switch (range_check)
440     {
441     case range_check_on:
442       tmp = "on";
443       break;
444     case range_check_off:
445       tmp = "off";
446       break;
447     case range_check_warn:
448       tmp = "warn";
449       break;
450     default:
451       error ("Unrecognized range check setting.");
452     }
453
454   free (range);
455   range = concat (pref, tmp, NULL);
456 }
457
458
459 /* Print out the current language settings: language, range and
460    type checking.  If QUIETLY, print only what has changed.  */
461
462 void
463 language_info (quietly)
464      int quietly;
465 {
466   if (quietly && expected_language == current_language)
467     return;
468
469   expected_language = current_language;
470   printf_unfiltered ("Current language:  %s\n", language);
471   show_language_command ((char *) 0, 1);
472
473   if (!quietly)
474     {
475       printf_unfiltered ("Type checking:     %s\n", type);
476       show_type_command ((char *) 0, 1);
477       printf_unfiltered ("Range checking:    %s\n", range);
478       show_range_command ((char *) 0, 1);
479     }
480 }
481 \f
482 /* Return the result of a binary operation. */
483
484 #if 0                           /* Currently unused */
485
486 struct type *
487 binop_result_type (v1, v2)
488      value_ptr v1, v2;
489 {
490   int size, uns;
491   struct type *t1 = check_typedef (VALUE_TYPE (v1));
492   struct type *t2 = check_typedef (VALUE_TYPE (v2));
493
494   int l1 = TYPE_LENGTH (t1);
495   int l2 = TYPE_LENGTH (t2);
496
497   switch (current_language->la_language)
498     {
499     case language_c:
500     case language_cplus:
501       if (TYPE_CODE (t1) == TYPE_CODE_FLT)
502         return TYPE_CODE (t2) == TYPE_CODE_FLT && l2 > l1 ?
503           VALUE_TYPE (v2) : VALUE_TYPE (v1);
504       else if (TYPE_CODE (t2) == TYPE_CODE_FLT)
505         return TYPE_CODE (t1) == TYPE_CODE_FLT && l1 > l2 ?
506           VALUE_TYPE (v1) : VALUE_TYPE (v2);
507       else if (TYPE_UNSIGNED (t1) && l1 > l2)
508         return VALUE_TYPE (v1);
509       else if (TYPE_UNSIGNED (t2) && l2 > l1)
510         return VALUE_TYPE (v2);
511       else                      /* Both are signed.  Result is the longer type */
512         return l1 > l2 ? VALUE_TYPE (v1) : VALUE_TYPE (v2);
513       break;
514     case language_m2:
515       /* If we are doing type-checking, l1 should equal l2, so this is
516          not needed. */
517       return l1 > l2 ? VALUE_TYPE (v1) : VALUE_TYPE (v2);
518       break;
519     case language_chill:
520       error ("Missing Chill support in function binop_result_check.");  /*FIXME */
521     }
522   abort ();
523   return (struct type *) 0;     /* For lint */
524 }
525
526 #endif /* 0 */
527 \f
528
529 /* This page contains functions that return format strings for
530    printf for printing out numbers in different formats */
531
532 /* Returns the appropriate printf format for hexadecimal
533    numbers. */
534 char *
535 local_hex_format_custom (pre)
536      char *pre;
537 {
538   static char form[50];
539
540   strcpy (form, local_hex_format_prefix ());
541   strcat (form, "%");
542   strcat (form, pre);
543   strcat (form, local_hex_format_specifier ());
544   strcat (form, local_hex_format_suffix ());
545   return form;
546 }
547
548 /* Converts a number to hexadecimal (without leading "0x") and stores it in a
549    static string.  Returns a pointer to this string. */
550
551 char *
552 longest_raw_hex_string (num)
553      LONGEST num;
554 {
555   static char res_longest_raw_hex_string[50];
556   long long ll = num;           /* MERGEBUG ?? see below */
557   res_longest_raw_hex_string[0] = 0;
558   /* MERGEBUG ?? As a quick fix I am replacing this with sprintf 
559      strcat_address_numeric (num, 0, res_longest_raw_hex_string, 50); 
560    */
561
562   sprintf (res_longest_raw_hex_string, "%llx", ll);
563   return res_longest_raw_hex_string;
564 }
565
566 /* Converts a number to hexadecimal and stores it in a static
567    string.  Returns a pointer to this string. */
568 char *
569 local_hex_string (num)
570      unsigned long num;
571 {
572   static char res[50];
573
574   sprintf (res, local_hex_format (), num);
575   return res;
576 }
577
578 /* Converts a LONGEST number to hexadecimal and stores it in a static
579    string.  Returns a pointer to this string. */
580 char *
581 longest_local_hex_string (num)
582      LONGEST num;
583 {
584   return longest_local_hex_string_custom (num, "l");
585 }
586
587 /* Converts a number to custom hexadecimal and stores it in a static
588    string.  Returns a pointer to this string. */
589 char *
590 local_hex_string_custom (num, pre)
591      unsigned long num;
592      char *pre;
593 {
594   static char res[50];
595
596   sprintf (res, local_hex_format_custom (pre), num);
597   return res;
598 }
599
600 /* Converts a LONGEST number to custom hexadecimal and stores it in a static
601    string.  Returns a pointer to this string. Note that the width parameter
602    should end with "l", e.g. "08l" as with calls to local_hex_string_custom */
603
604 char *
605 longest_local_hex_string_custom (num, width)
606      LONGEST num;
607      char *width;
608 {
609 #define RESULT_BUF_LEN 50
610   static char res2[RESULT_BUF_LEN];
611   char format[RESULT_BUF_LEN];
612 #if !defined (PRINTF_HAS_LONG_LONG)
613   int field_width;
614   int num_len;
615   int num_pad_chars;
616   char *pad_char;               /* string with one character */
617   int pad_on_left;
618   char *parse_ptr;
619   char temp_nbr_buf[RESULT_BUF_LEN];
620 #endif
621
622 #ifndef CC_HAS_LONG_LONG
623   /* If there is no long long, then LONGEST should be just long and we
624      can use local_hex_string_custom 
625    */
626   return local_hex_string_custom ((unsigned long) num, width);
627 #endif
628
629 #if defined (PRINTF_HAS_LONG_LONG)
630   /* Just use printf.  */
631   strcpy (format, local_hex_format_prefix ());  /* 0x */
632   strcat (format, "%");
633   strcat (format, width);       /* e.g. "08l" */
634   strcat (format, "l");         /* need "ll" for long long */
635   strcat (format, local_hex_format_specifier ());       /* "x" */
636   strcat (format, local_hex_format_suffix ());  /* "" */
637   sprintf (res2, format, num);
638   return res2;
639 #else /* !defined (PRINTF_HAS_LONG_LONG) */
640   /* Use strcat_address_numeric to print the number into a string, then
641      build the result string from local_hex_format_prefix, padding and 
642      the hex representation as indicated by "width".  */
643
644   temp_nbr_buf[0] = 0;
645   /* With use_local == 0, we don't get the leading "0x" prefix. */
646   /* MERGEBUG ?? As a quick fix I am replacing this call to
647      strcat_address_numeric with sprintf
648      strcat_address_numeric(num, 0, temp_nbr_buf, RESULT_BUF_LEN);
649    */
650
651   {
652     long long ll = num;
653     sprintf (temp_nbr_buf, "%llx", ll);
654   }
655   /* parse width */
656   parse_ptr = width;
657   pad_on_left = 1;
658   pad_char = " ";
659   if (*parse_ptr == '-')
660     {
661       parse_ptr++;
662       pad_on_left = 0;
663     }
664   if (*parse_ptr == '0')
665     {
666       parse_ptr++;
667       if (pad_on_left)
668         pad_char = "0";         /* If padding is on the right, it is blank */
669     }
670   field_width = atoi (parse_ptr);
671   num_len = strlen (temp_nbr_buf);
672   num_pad_chars = field_width - strlen (temp_nbr_buf);  /* possibly negative */
673
674   if (strlen (local_hex_format_prefix ()) + num_len + num_pad_chars
675       < RESULT_BUF_LEN)         /* paranoia */
676     internal_error ("longest_local_hex_string_custom: insufficient space to store result");
677
678   strcpy (res2, local_hex_format_prefix ());
679   if (pad_on_left)
680     {
681       while (num_pad_chars > 0)
682         {
683           strcat (res2, pad_char);
684           num_pad_chars--;
685         }
686     }
687   strcat (res2, temp_nbr_buf);
688   if (!pad_on_left)
689     {
690       while (num_pad_chars > 0)
691         {
692           strcat (res2, pad_char);
693           num_pad_chars--;
694         }
695     }
696   return res2;
697 #endif
698
699 }                               /* longest_local_hex_string_custom */
700
701 /* Returns the appropriate printf format for octal
702    numbers. */
703 char *
704 local_octal_format_custom (pre)
705      char *pre;
706 {
707   static char form[50];
708
709   strcpy (form, local_octal_format_prefix ());
710   strcat (form, "%");
711   strcat (form, pre);
712   strcat (form, local_octal_format_specifier ());
713   strcat (form, local_octal_format_suffix ());
714   return form;
715 }
716
717 /* Returns the appropriate printf format for decimal numbers. */
718 char *
719 local_decimal_format_custom (pre)
720      char *pre;
721 {
722   static char form[50];
723
724   strcpy (form, local_decimal_format_prefix ());
725   strcat (form, "%");
726   strcat (form, pre);
727   strcat (form, local_decimal_format_specifier ());
728   strcat (form, local_decimal_format_suffix ());
729   return form;
730 }
731 \f
732 #if 0
733 /* This page contains functions that are used in type/range checking.
734    They all return zero if the type/range check fails.
735
736    It is hoped that these will make extending GDB to parse different
737    languages a little easier.  These are primarily used in eval.c when
738    evaluating expressions and making sure that their types are correct.
739    Instead of having a mess of conjucted/disjuncted expressions in an "if",
740    the ideas of type can be wrapped up in the following functions.
741
742    Note that some of them are not currently dependent upon which language
743    is currently being parsed.  For example, floats are the same in
744    C and Modula-2 (ie. the only floating point type has TYPE_CODE of
745    TYPE_CODE_FLT), while booleans are different. */
746
747 /* Returns non-zero if its argument is a simple type.  This is the same for
748    both Modula-2 and for C.  In the C case, TYPE_CODE_CHAR will never occur,
749    and thus will never cause the failure of the test. */
750 int
751 simple_type (type)
752      struct type *type;
753 {
754   CHECK_TYPEDEF (type);
755   switch (TYPE_CODE (type))
756     {
757     case TYPE_CODE_INT:
758     case TYPE_CODE_CHAR:
759     case TYPE_CODE_ENUM:
760     case TYPE_CODE_FLT:
761     case TYPE_CODE_RANGE:
762     case TYPE_CODE_BOOL:
763       return 1;
764
765     default:
766       return 0;
767     }
768 }
769
770 /* Returns non-zero if its argument is of an ordered type.
771    An ordered type is one in which the elements can be tested for the
772    properties of "greater than", "less than", etc, or for which the
773    operations "increment" or "decrement" make sense. */
774 int
775 ordered_type (type)
776      struct type *type;
777 {
778   CHECK_TYPEDEF (type);
779   switch (TYPE_CODE (type))
780     {
781     case TYPE_CODE_INT:
782     case TYPE_CODE_CHAR:
783     case TYPE_CODE_ENUM:
784     case TYPE_CODE_FLT:
785     case TYPE_CODE_RANGE:
786       return 1;
787
788     default:
789       return 0;
790     }
791 }
792
793 /* Returns non-zero if the two types are the same */
794 int
795 same_type (arg1, arg2)
796      struct type *arg1, *arg2;
797 {
798   CHECK_TYPEDEF (type);
799   if (structured_type (arg1) ? !structured_type (arg2) : structured_type (arg2))
800     /* One is structured and one isn't */
801     return 0;
802   else if (structured_type (arg1) && structured_type (arg2))
803     return arg1 == arg2;
804   else if (numeric_type (arg1) && numeric_type (arg2))
805     return (TYPE_CODE (arg2) == TYPE_CODE (arg1)) &&
806       (TYPE_UNSIGNED (arg1) == TYPE_UNSIGNED (arg2))
807       ? 1 : 0;
808   else
809     return arg1 == arg2;
810 }
811
812 /* Returns non-zero if the type is integral */
813 int
814 integral_type (type)
815      struct type *type;
816 {
817   CHECK_TYPEDEF (type);
818   switch (current_language->la_language)
819     {
820     case language_c:
821     case language_cplus:
822       return (TYPE_CODE (type) != TYPE_CODE_INT) &&
823         (TYPE_CODE (type) != TYPE_CODE_ENUM) ? 0 : 1;
824     case language_m2:
825       return TYPE_CODE (type) != TYPE_CODE_INT ? 0 : 1;
826     case language_chill:
827       error ("Missing Chill support in function integral_type.");       /*FIXME */
828     default:
829       error ("Language not supported.");
830     }
831 }
832
833 /* Returns non-zero if the value is numeric */
834 int
835 numeric_type (type)
836      struct type *type;
837 {
838   CHECK_TYPEDEF (type);
839   switch (TYPE_CODE (type))
840     {
841     case TYPE_CODE_INT:
842     case TYPE_CODE_FLT:
843       return 1;
844
845     default:
846       return 0;
847     }
848 }
849
850 /* Returns non-zero if the value is a character type */
851 int
852 character_type (type)
853      struct type *type;
854 {
855   CHECK_TYPEDEF (type);
856   switch (current_language->la_language)
857     {
858     case language_chill:
859     case language_m2:
860       return TYPE_CODE (type) != TYPE_CODE_CHAR ? 0 : 1;
861
862     case language_c:
863     case language_cplus:
864       return (TYPE_CODE (type) == TYPE_CODE_INT) &&
865         TYPE_LENGTH (type) == sizeof (char)
866       ? 1 : 0;
867     default:
868       return (0);
869     }
870 }
871
872 /* Returns non-zero if the value is a string type */
873 int
874 string_type (type)
875      struct type *type;
876 {
877   CHECK_TYPEDEF (type);
878   switch (current_language->la_language)
879     {
880     case language_chill:
881     case language_m2:
882       return TYPE_CODE (type) != TYPE_CODE_STRING ? 0 : 1;
883
884     case language_c:
885     case language_cplus:
886       /* C does not have distinct string type. */
887       return (0);
888     default:
889       return (0);
890     }
891 }
892
893 /* Returns non-zero if the value is a boolean type */
894 int
895 boolean_type (type)
896      struct type *type;
897 {
898   CHECK_TYPEDEF (type);
899   if (TYPE_CODE (type) == TYPE_CODE_BOOL)
900     return 1;
901   switch (current_language->la_language)
902     {
903     case language_c:
904     case language_cplus:
905       /* Might be more cleanly handled by having a TYPE_CODE_INT_NOT_BOOL
906          for CHILL and such languages, or a TYPE_CODE_INT_OR_BOOL for C.  */
907       if (TYPE_CODE (type) == TYPE_CODE_INT)
908         return 1;
909     default:
910       break;
911     }
912   return 0;
913 }
914
915 /* Returns non-zero if the value is a floating-point type */
916 int
917 float_type (type)
918      struct type *type;
919 {
920   CHECK_TYPEDEF (type);
921   return TYPE_CODE (type) == TYPE_CODE_FLT;
922 }
923
924 /* Returns non-zero if the value is a pointer type */
925 int
926 pointer_type (type)
927      struct type *type;
928 {
929   return TYPE_CODE (type) == TYPE_CODE_PTR ||
930     TYPE_CODE (type) == TYPE_CODE_REF;
931 }
932
933 /* Returns non-zero if the value is a structured type */
934 int
935 structured_type (type)
936      struct type *type;
937 {
938   CHECK_TYPEDEF (type);
939   switch (current_language->la_language)
940     {
941     case language_c:
942     case language_cplus:
943       return (TYPE_CODE (type) == TYPE_CODE_STRUCT) ||
944         (TYPE_CODE (type) == TYPE_CODE_UNION) ||
945         (TYPE_CODE (type) == TYPE_CODE_ARRAY);
946     case language_m2:
947       return (TYPE_CODE (type) == TYPE_CODE_STRUCT) ||
948         (TYPE_CODE (type) == TYPE_CODE_SET) ||
949         (TYPE_CODE (type) == TYPE_CODE_ARRAY);
950     case language_chill:
951       error ("Missing Chill support in function structured_type.");     /*FIXME */
952     default:
953       return (0);
954     }
955 }
956 #endif
957 \f
958 struct type *
959 lang_bool_type ()
960 {
961   struct symbol *sym;
962   struct type *type;
963   switch (current_language->la_language)
964     {
965     case language_chill:
966       return builtin_type_chill_bool;
967     case language_fortran:
968       sym = lookup_symbol ("logical", NULL, VAR_NAMESPACE, NULL, NULL);
969       if (sym)
970         {
971           type = SYMBOL_TYPE (sym);
972           if (type && TYPE_CODE (type) == TYPE_CODE_BOOL)
973             return type;
974         }
975       return builtin_type_f_logical_s2;
976     case language_cplus:
977       sym = lookup_symbol ("bool", NULL, VAR_NAMESPACE, NULL, NULL);
978       if (sym)
979         {
980           type = SYMBOL_TYPE (sym);
981           if (type && TYPE_CODE (type) == TYPE_CODE_BOOL)
982             return type;
983         }
984       return builtin_type_bool;
985     default:
986       return builtin_type_int;
987     }
988 }
989 \f
990 /* This page contains functions that return info about
991    (struct value) values used in GDB. */
992
993 /* Returns non-zero if the value VAL represents a true value. */
994 int
995 value_true (val)
996      value_ptr val;
997 {
998   /* It is possible that we should have some sort of error if a non-boolean
999      value is used in this context.  Possibly dependent on some kind of
1000      "boolean-checking" option like range checking.  But it should probably
1001      not depend on the language except insofar as is necessary to identify
1002      a "boolean" value (i.e. in C using a float, pointer, etc., as a boolean
1003      should be an error, probably).  */
1004   return !value_logical_not (val);
1005 }
1006 \f
1007 /* Returns non-zero if the operator OP is defined on
1008    the values ARG1 and ARG2. */
1009
1010 #if 0                           /* Currently unused */
1011
1012 void
1013 binop_type_check (arg1, arg2, op)
1014      value_ptr arg1, arg2;
1015      int op;
1016 {
1017   struct type *t1, *t2;
1018
1019   /* If we're not checking types, always return success. */
1020   if (!STRICT_TYPE)
1021     return;
1022
1023   t1 = VALUE_TYPE (arg1);
1024   if (arg2 != NULL)
1025     t2 = VALUE_TYPE (arg2);
1026   else
1027     t2 = NULL;
1028
1029   switch (op)
1030     {
1031     case BINOP_ADD:
1032     case BINOP_SUB:
1033       if ((numeric_type (t1) && pointer_type (t2)) ||
1034           (pointer_type (t1) && numeric_type (t2)))
1035         {
1036           warning ("combining pointer and integer.\n");
1037           break;
1038         }
1039     case BINOP_MUL:
1040     case BINOP_LSH:
1041     case BINOP_RSH:
1042       if (!numeric_type (t1) || !numeric_type (t2))
1043         type_op_error ("Arguments to %s must be numbers.", op);
1044       else if (!same_type (t1, t2))
1045         type_op_error ("Arguments to %s must be of the same type.", op);
1046       break;
1047
1048     case BINOP_LOGICAL_AND:
1049     case BINOP_LOGICAL_OR:
1050       if (!boolean_type (t1) || !boolean_type (t2))
1051         type_op_error ("Arguments to %s must be of boolean type.", op);
1052       break;
1053
1054     case BINOP_EQUAL:
1055       if ((pointer_type (t1) && !(pointer_type (t2) || integral_type (t2))) ||
1056           (pointer_type (t2) && !(pointer_type (t1) || integral_type (t1))))
1057         type_op_error ("A pointer can only be compared to an integer or pointer.", op);
1058       else if ((pointer_type (t1) && integral_type (t2)) ||
1059                (integral_type (t1) && pointer_type (t2)))
1060         {
1061           warning ("combining integer and pointer.\n");
1062           break;
1063         }
1064       else if (!simple_type (t1) || !simple_type (t2))
1065         type_op_error ("Arguments to %s must be of simple type.", op);
1066       else if (!same_type (t1, t2))
1067         type_op_error ("Arguments to %s must be of the same type.", op);
1068       break;
1069
1070     case BINOP_REM:
1071     case BINOP_MOD:
1072       if (!integral_type (t1) || !integral_type (t2))
1073         type_op_error ("Arguments to %s must be of integral type.", op);
1074       break;
1075
1076     case BINOP_LESS:
1077     case BINOP_GTR:
1078     case BINOP_LEQ:
1079     case BINOP_GEQ:
1080       if (!ordered_type (t1) || !ordered_type (t2))
1081         type_op_error ("Arguments to %s must be of ordered type.", op);
1082       else if (!same_type (t1, t2))
1083         type_op_error ("Arguments to %s must be of the same type.", op);
1084       break;
1085
1086     case BINOP_ASSIGN:
1087       if (pointer_type (t1) && !integral_type (t2))
1088         type_op_error ("A pointer can only be assigned an integer.", op);
1089       else if (pointer_type (t1) && integral_type (t2))
1090         {
1091           warning ("combining integer and pointer.");
1092           break;
1093         }
1094       else if (!simple_type (t1) || !simple_type (t2))
1095         type_op_error ("Arguments to %s must be of simple type.", op);
1096       else if (!same_type (t1, t2))
1097         type_op_error ("Arguments to %s must be of the same type.", op);
1098       break;
1099
1100     case BINOP_CONCAT:
1101       /* FIXME:  Needs to handle bitstrings as well. */
1102       if (!(string_type (t1) || character_type (t1) || integral_type (t1))
1103         || !(string_type (t2) || character_type (t2) || integral_type (t2)))
1104         type_op_error ("Arguments to %s must be strings or characters.", op);
1105       break;
1106
1107       /* Unary checks -- arg2 is null */
1108
1109     case UNOP_LOGICAL_NOT:
1110       if (!boolean_type (t1))
1111         type_op_error ("Argument to %s must be of boolean type.", op);
1112       break;
1113
1114     case UNOP_PLUS:
1115     case UNOP_NEG:
1116       if (!numeric_type (t1))
1117         type_op_error ("Argument to %s must be of numeric type.", op);
1118       break;
1119
1120     case UNOP_IND:
1121       if (integral_type (t1))
1122         {
1123           warning ("combining pointer and integer.\n");
1124           break;
1125         }
1126       else if (!pointer_type (t1))
1127         type_op_error ("Argument to %s must be a pointer.", op);
1128       break;
1129
1130     case UNOP_PREINCREMENT:
1131     case UNOP_POSTINCREMENT:
1132     case UNOP_PREDECREMENT:
1133     case UNOP_POSTDECREMENT:
1134       if (!ordered_type (t1))
1135         type_op_error ("Argument to %s must be of an ordered type.", op);
1136       break;
1137
1138     default:
1139       /* Ok.  The following operators have different meanings in
1140          different languages. */
1141       switch (current_language->la_language)
1142         {
1143 #ifdef _LANG_c
1144         case language_c:
1145         case language_cplus:
1146           switch (op)
1147             {
1148             case BINOP_DIV:
1149               if (!numeric_type (t1) || !numeric_type (t2))
1150                 type_op_error ("Arguments to %s must be numbers.", op);
1151               break;
1152             }
1153           break;
1154 #endif
1155
1156 #ifdef _LANG_m2
1157         case language_m2:
1158           switch (op)
1159             {
1160             case BINOP_DIV:
1161               if (!float_type (t1) || !float_type (t2))
1162                 type_op_error ("Arguments to %s must be floating point numbers.", op);
1163               break;
1164             case BINOP_INTDIV:
1165               if (!integral_type (t1) || !integral_type (t2))
1166                 type_op_error ("Arguments to %s must be of integral type.", op);
1167               break;
1168             }
1169 #endif
1170
1171 #ifdef _LANG_chill
1172         case language_chill:
1173           error ("Missing Chill support in function binop_type_check.");        /*FIXME */
1174 #endif
1175
1176         }
1177     }
1178 }
1179
1180 #endif /* 0 */
1181 \f
1182
1183 /* This page contains functions for the printing out of
1184    error messages that occur during type- and range-
1185    checking. */
1186
1187 /* Prints the format string FMT with the operator as a string
1188    corresponding to the opcode OP.  If FATAL is non-zero, then
1189    this is an error and error () is called.  Otherwise, it is
1190    a warning and printf() is called. */
1191 void
1192 op_error (fmt, op, fatal)
1193      char *fmt;
1194      enum exp_opcode op;
1195      int fatal;
1196 {
1197   if (fatal)
1198     error (fmt, op_string (op));
1199   else
1200     {
1201       warning (fmt, op_string (op));
1202     }
1203 }
1204
1205 /* These are called when a language fails a type- or range-check.
1206    The first argument should be a printf()-style format string, and
1207    the rest of the arguments should be its arguments.  If
1208    [type|range]_check is [type|range]_check_on, then return_to_top_level()
1209    is called in the style of error ().  Otherwise, the message is prefixed
1210    by the value of warning_pre_print and we do not return to the top level. */
1211
1212 void
1213 type_error (char *string,...)
1214 {
1215   va_list args;
1216   va_start (args, string);
1217
1218   if (type_check == type_check_warn)
1219     fprintf_filtered (gdb_stderr, warning_pre_print);
1220   else
1221     error_begin ();
1222
1223   vfprintf_filtered (gdb_stderr, string, args);
1224   fprintf_filtered (gdb_stderr, "\n");
1225   va_end (args);
1226   if (type_check == type_check_on)
1227     return_to_top_level (RETURN_ERROR);
1228 }
1229
1230 void
1231 range_error (char *string,...)
1232 {
1233   va_list args;
1234   va_start (args, string);
1235
1236   if (range_check == range_check_warn)
1237     fprintf_filtered (gdb_stderr, warning_pre_print);
1238   else
1239     error_begin ();
1240
1241   vfprintf_filtered (gdb_stderr, string, args);
1242   fprintf_filtered (gdb_stderr, "\n");
1243   va_end (args);
1244   if (range_check == range_check_on)
1245     return_to_top_level (RETURN_ERROR);
1246 }
1247 \f
1248
1249 /* This page contains miscellaneous functions */
1250
1251 /* Return the language enum for a given language string. */
1252
1253 enum language
1254 language_enum (str)
1255      char *str;
1256 {
1257   int i;
1258
1259   for (i = 0; i < languages_size; i++)
1260     if (STREQ (languages[i]->la_name, str))
1261       return languages[i]->la_language;
1262
1263   return language_unknown;
1264 }
1265
1266 /* Return the language struct for a given language enum. */
1267
1268 const struct language_defn *
1269 language_def (lang)
1270      enum language lang;
1271 {
1272   int i;
1273
1274   for (i = 0; i < languages_size; i++)
1275     {
1276       if (languages[i]->la_language == lang)
1277         {
1278           return languages[i];
1279         }
1280     }
1281   return NULL;
1282 }
1283
1284 /* Return the language as a string */
1285 char *
1286 language_str (lang)
1287      enum language lang;
1288 {
1289   int i;
1290
1291   for (i = 0; i < languages_size; i++)
1292     {
1293       if (languages[i]->la_language == lang)
1294         {
1295           return languages[i]->la_name;
1296         }
1297     }
1298   return "Unknown";
1299 }
1300
1301 static void
1302 set_check (ignore, from_tty)
1303      char *ignore;
1304      int from_tty;
1305 {
1306   printf_unfiltered (
1307      "\"set check\" must be followed by the name of a check subcommand.\n");
1308   help_list (setchecklist, "set check ", -1, gdb_stdout);
1309 }
1310
1311 static void
1312 show_check (ignore, from_tty)
1313      char *ignore;
1314      int from_tty;
1315 {
1316   cmd_show_list (showchecklist, from_tty, "");
1317 }
1318 \f
1319 /* Add a language to the set of known languages.  */
1320
1321 void
1322 add_language (lang)
1323      const struct language_defn *lang;
1324 {
1325   if (lang->la_magic != LANG_MAGIC)
1326     {
1327       fprintf_unfiltered (gdb_stderr, "Magic number of %s language struct wrong\n",
1328                           lang->la_name);
1329       abort ();
1330     }
1331
1332   if (!languages)
1333     {
1334       languages_allocsize = DEFAULT_ALLOCSIZE;
1335       languages = (const struct language_defn **) xmalloc
1336         (languages_allocsize * sizeof (*languages));
1337     }
1338   if (languages_size >= languages_allocsize)
1339     {
1340       languages_allocsize *= 2;
1341       languages = (const struct language_defn **) xrealloc ((char *) languages,
1342                                  languages_allocsize * sizeof (*languages));
1343     }
1344   languages[languages_size++] = lang;
1345 }
1346
1347 /* Define the language that is no language.  */
1348
1349 static int
1350 unk_lang_parser ()
1351 {
1352   return 1;
1353 }
1354
1355 static void
1356 unk_lang_error (msg)
1357      char *msg;
1358 {
1359   error ("Attempted to parse an expression with unknown language");
1360 }
1361
1362 static void
1363 unk_lang_emit_char (c, stream, quoter)
1364      register int c;
1365      struct ui_file *stream;
1366      int quoter;
1367 {
1368   error ("internal error - unimplemented function unk_lang_emit_char called.");
1369 }
1370
1371 static void
1372 unk_lang_printchar (c, stream)
1373      register int c;
1374      struct ui_file *stream;
1375 {
1376   error ("internal error - unimplemented function unk_lang_printchar called.");
1377 }
1378
1379 static void
1380 unk_lang_printstr (stream, string, length, width, force_ellipses)
1381      struct ui_file *stream;
1382      char *string;
1383      unsigned int length;
1384      int width;
1385      int force_ellipses;
1386 {
1387   error ("internal error - unimplemented function unk_lang_printstr called.");
1388 }
1389
1390 static struct type *
1391 unk_lang_create_fundamental_type (objfile, typeid)
1392      struct objfile *objfile;
1393      int typeid;
1394 {
1395   error ("internal error - unimplemented function unk_lang_create_fundamental_type called.");
1396 }
1397
1398 static void
1399 unk_lang_print_type (type, varstring, stream, show, level)
1400      struct type *type;
1401      char *varstring;
1402      struct ui_file *stream;
1403      int show;
1404      int level;
1405 {
1406   error ("internal error - unimplemented function unk_lang_print_type called.");
1407 }
1408
1409 static int
1410 unk_lang_val_print (type, valaddr, embedded_offset, address, stream, format, deref_ref,
1411                     recurse, pretty)
1412      struct type *type;
1413      char *valaddr;
1414      int embedded_offset;
1415      CORE_ADDR address;
1416      struct ui_file *stream;
1417      int format;
1418      int deref_ref;
1419      int recurse;
1420      enum val_prettyprint pretty;
1421 {
1422   error ("internal error - unimplemented function unk_lang_val_print called.");
1423 }
1424
1425 static int
1426 unk_lang_value_print (val, stream, format, pretty)
1427      value_ptr val;
1428      struct ui_file *stream;
1429      int format;
1430      enum val_prettyprint pretty;
1431 {
1432   error ("internal error - unimplemented function unk_lang_value_print called.");
1433 }
1434
1435 static struct type **CONST_PTR (unknown_builtin_types[]) =
1436 {
1437   0
1438 };
1439 static const struct op_print unk_op_print_tab[] =
1440 {
1441   {NULL, OP_NULL, PREC_NULL, 0}
1442 };
1443
1444 const struct language_defn unknown_language_defn =
1445 {
1446   "unknown",
1447   language_unknown,
1448   &unknown_builtin_types[0],
1449   range_check_off,
1450   type_check_off,
1451   unk_lang_parser,
1452   unk_lang_error,
1453   evaluate_subexp_standard,
1454   unk_lang_printchar,           /* Print character constant */
1455   unk_lang_printstr,
1456   unk_lang_emit_char,
1457   unk_lang_create_fundamental_type,
1458   unk_lang_print_type,          /* Print a type using appropriate syntax */
1459   unk_lang_val_print,           /* Print a value using appropriate syntax */
1460   unk_lang_value_print,         /* Print a top-level value */
1461   {"", "", "", ""},             /* Binary format info */
1462   {"0%lo", "0", "o", ""},       /* Octal format info */
1463   {"%ld", "", "d", ""},         /* Decimal format info */
1464   {"0x%lx", "0x", "x", ""},     /* Hex format info */
1465   unk_op_print_tab,             /* expression operators for printing */
1466   1,                            /* c-style arrays */
1467   0,                            /* String lower bound */
1468   &builtin_type_char,           /* Type of string elements */
1469   LANG_MAGIC
1470 };
1471
1472 /* These two structs define fake entries for the "local" and "auto" options. */
1473 const struct language_defn auto_language_defn =
1474 {
1475   "auto",
1476   language_auto,
1477   &unknown_builtin_types[0],
1478   range_check_off,
1479   type_check_off,
1480   unk_lang_parser,
1481   unk_lang_error,
1482   evaluate_subexp_standard,
1483   unk_lang_printchar,           /* Print character constant */
1484   unk_lang_printstr,
1485   unk_lang_emit_char,
1486   unk_lang_create_fundamental_type,
1487   unk_lang_print_type,          /* Print a type using appropriate syntax */
1488   unk_lang_val_print,           /* Print a value using appropriate syntax */
1489   unk_lang_value_print,         /* Print a top-level value */
1490   {"", "", "", ""},             /* Binary format info */
1491   {"0%lo", "0", "o", ""},       /* Octal format info */
1492   {"%ld", "", "d", ""},         /* Decimal format info */
1493   {"0x%lx", "0x", "x", ""},     /* Hex format info */
1494   unk_op_print_tab,             /* expression operators for printing */
1495   1,                            /* c-style arrays */
1496   0,                            /* String lower bound */
1497   &builtin_type_char,           /* Type of string elements */
1498   LANG_MAGIC
1499 };
1500
1501 const struct language_defn local_language_defn =
1502 {
1503   "local",
1504   language_auto,
1505   &unknown_builtin_types[0],
1506   range_check_off,
1507   type_check_off,
1508   unk_lang_parser,
1509   unk_lang_error,
1510   evaluate_subexp_standard,
1511   unk_lang_printchar,           /* Print character constant */
1512   unk_lang_printstr,
1513   unk_lang_emit_char,
1514   unk_lang_create_fundamental_type,
1515   unk_lang_print_type,          /* Print a type using appropriate syntax */
1516   unk_lang_val_print,           /* Print a value using appropriate syntax */
1517   unk_lang_value_print,         /* Print a top-level value */
1518   {"", "", "", ""},             /* Binary format info */
1519   {"0%lo", "0", "o", ""},       /* Octal format info */
1520   {"%ld", "", "d", ""},         /* Decimal format info */
1521   {"0x%lx", "0x", "x", ""},     /* Hex format info */
1522   unk_op_print_tab,             /* expression operators for printing */
1523   1,                            /* c-style arrays */
1524   0,                            /* String lower bound */
1525   &builtin_type_char,           /* Type of string elements */
1526   LANG_MAGIC
1527 };
1528 \f
1529 /* Initialize the language routines */
1530
1531 void
1532 _initialize_language ()
1533 {
1534   struct cmd_list_element *set, *show;
1535
1536   /* GDB commands for language specific stuff */
1537
1538   set = add_set_cmd ("language", class_support, var_string_noescape,
1539                      (char *) &language,
1540                      "Set the current source language.",
1541                      &setlist);
1542   show = add_show_from_set (set, &showlist);
1543   set->function.cfunc = set_language_command;
1544   show->function.cfunc = show_language_command;
1545
1546   add_prefix_cmd ("check", no_class, set_check,
1547                   "Set the status of the type/range checker",
1548                   &setchecklist, "set check ", 0, &setlist);
1549   add_alias_cmd ("c", "check", no_class, 1, &setlist);
1550   add_alias_cmd ("ch", "check", no_class, 1, &setlist);
1551
1552   add_prefix_cmd ("check", no_class, show_check,
1553                   "Show the status of the type/range checker",
1554                   &showchecklist, "show check ", 0, &showlist);
1555   add_alias_cmd ("c", "check", no_class, 1, &showlist);
1556   add_alias_cmd ("ch", "check", no_class, 1, &showlist);
1557
1558   set = add_set_cmd ("type", class_support, var_string_noescape,
1559                      (char *) &type,
1560                      "Set type checking.  (on/warn/off/auto)",
1561                      &setchecklist);
1562   show = add_show_from_set (set, &showchecklist);
1563   set->function.cfunc = set_type_command;
1564   show->function.cfunc = show_type_command;
1565
1566   set = add_set_cmd ("range", class_support, var_string_noescape,
1567                      (char *) &range,
1568                      "Set range checking.  (on/warn/off/auto)",
1569                      &setchecklist);
1570   show = add_show_from_set (set, &showchecklist);
1571   set->function.cfunc = set_range_command;
1572   show->function.cfunc = show_range_command;
1573
1574   add_language (&unknown_language_defn);
1575   add_language (&local_language_defn);
1576   add_language (&auto_language_defn);
1577
1578   language = savestring ("auto", strlen ("auto"));
1579   set_language_command (language, 0);
1580
1581   type = savestring ("auto", strlen ("auto"));
1582   set_type_command (NULL, 0);
1583
1584   range = savestring ("auto", strlen ("auto"));
1585   set_range_command (NULL, 0);
1586 }