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