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