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