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