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