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