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