gdb/language.c

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