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