gdb/language.c

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