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 }