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 type_error (char *string,...)
1080 {
1081   va_list args;
1082   va_start (args, string);
1083
1084   if (type_check == type_check_warn)
1085     fprintf_filtered (gdb_stderr, warning_pre_print);
1086   else
1087     error_begin ();
1088
1089   vfprintf_filtered (gdb_stderr, string, args);
1090   fprintf_filtered (gdb_stderr, "\n");
1091   va_end (args);
1092   if (type_check == type_check_on)
1093     return_to_top_level (RETURN_ERROR);
1094 }
1095
1096 void
1097 range_error (char *string,...)
1098 {
1099   va_list args;
1100   va_start (args, string);
1101
1102   if (range_check == range_check_warn)
1103     fprintf_filtered (gdb_stderr, warning_pre_print);
1104   else
1105     error_begin ();
1106
1107   vfprintf_filtered (gdb_stderr, string, args);
1108   fprintf_filtered (gdb_stderr, "\n");
1109   va_end (args);
1110   if (range_check == range_check_on)
1111     return_to_top_level (RETURN_ERROR);
1112 }
1113 \f
1114
1115 /* This page contains miscellaneous functions */
1116
1117 /* Return the language enum for a given language string. */
1118
1119 enum language
1120 language_enum (str)
1121      char *str;
1122 {
1123   int i;
1124
1125   for (i = 0; i < languages_size; i++)
1126     if (STREQ (languages[i]->la_name, str))
1127       return languages[i]->la_language;
1128
1129   return language_unknown;
1130 }
1131
1132 /* Return the language struct for a given language enum. */
1133
1134 const struct language_defn *
1135 language_def (lang)
1136      enum language lang;
1137 {
1138   int i;
1139
1140   for (i = 0; i < languages_size; i++)
1141     {
1142       if (languages[i]->la_language == lang)
1143         {
1144           return languages[i];
1145         }
1146     }
1147   return NULL;
1148 }
1149
1150 /* Return the language as a string */
1151 char *
1152 language_str (lang)
1153      enum language lang;
1154 {
1155   int i;
1156
1157   for (i = 0; i < languages_size; i++)
1158     {
1159       if (languages[i]->la_language == lang)
1160         {
1161           return languages[i]->la_name;
1162         }
1163     }
1164   return "Unknown";
1165 }
1166
1167 static void
1168 set_check (ignore, from_tty)
1169      char *ignore;
1170      int from_tty;
1171 {
1172   printf_unfiltered (
1173      "\"set check\" must be followed by the name of a check subcommand.\n");
1174   help_list (setchecklist, "set check ", -1, gdb_stdout);
1175 }
1176
1177 static void
1178 show_check (ignore, from_tty)
1179      char *ignore;
1180      int from_tty;
1181 {
1182   cmd_show_list (showchecklist, from_tty, "");
1183 }
1184 \f
1185 /* Add a language to the set of known languages.  */
1186
1187 void
1188 add_language (lang)
1189      const struct language_defn *lang;
1190 {
1191   if (lang->la_magic != LANG_MAGIC)
1192     {
1193       fprintf_unfiltered (gdb_stderr, "Magic number of %s language struct wrong\n",
1194                           lang->la_name);
1195       abort ();
1196     }
1197
1198   if (!languages)
1199     {
1200       languages_allocsize = DEFAULT_ALLOCSIZE;
1201       languages = (const struct language_defn **) xmalloc
1202         (languages_allocsize * sizeof (*languages));
1203     }
1204   if (languages_size >= languages_allocsize)
1205     {
1206       languages_allocsize *= 2;
1207       languages = (const struct language_defn **) xrealloc ((char *) languages,
1208                                  languages_allocsize * sizeof (*languages));
1209     }
1210   languages[languages_size++] = lang;
1211 }
1212
1213 /* Define the language that is no language.  */
1214
1215 static int
1216 unk_lang_parser ()
1217 {
1218   return 1;
1219 }
1220
1221 static void
1222 unk_lang_error (msg)
1223      char *msg;
1224 {
1225   error ("Attempted to parse an expression with unknown language");
1226 }
1227
1228 static void
1229 unk_lang_emit_char (c, stream, quoter)
1230      register int c;
1231      GDB_FILE *stream;
1232      int quoter;
1233 {
1234   error ("internal error - unimplemented function unk_lang_emit_char called.");
1235 }
1236
1237 static void
1238 unk_lang_printchar (c, stream)
1239      register int c;
1240      GDB_FILE *stream;
1241 {
1242   error ("internal error - unimplemented function unk_lang_printchar called.");
1243 }
1244
1245 static void
1246 unk_lang_printstr (stream, string, length, width, force_ellipses)
1247      GDB_FILE *stream;
1248      char *string;
1249      unsigned int length;
1250      int width;
1251      int force_ellipses;
1252 {
1253   error ("internal error - unimplemented function unk_lang_printstr called.");
1254 }
1255
1256 static struct type *
1257 unk_lang_create_fundamental_type (objfile, typeid)
1258      struct objfile *objfile;
1259      int typeid;
1260 {
1261   error ("internal error - unimplemented function unk_lang_create_fundamental_type called.");
1262 }
1263
1264 static void
1265 unk_lang_print_type (type, varstring, stream, show, level)
1266      struct type *type;
1267      char *varstring;
1268      GDB_FILE *stream;
1269      int show;
1270      int level;
1271 {
1272   error ("internal error - unimplemented function unk_lang_print_type called.");
1273 }
1274
1275 static int
1276 unk_lang_val_print (type, valaddr, embedded_offset, address, stream, format, deref_ref,
1277                     recurse, pretty)
1278      struct type *type;
1279      char *valaddr;
1280      int embedded_offset;
1281      CORE_ADDR address;
1282      GDB_FILE *stream;
1283      int format;
1284      int deref_ref;
1285      int recurse;
1286      enum val_prettyprint pretty;
1287 {
1288   error ("internal error - unimplemented function unk_lang_val_print called.");
1289 }
1290
1291 static int
1292 unk_lang_value_print (val, stream, format, pretty)
1293      value_ptr val;
1294      GDB_FILE *stream;
1295      int format;
1296      enum val_prettyprint pretty;
1297 {
1298   error ("internal error - unimplemented function unk_lang_value_print called.");
1299 }
1300
1301 static struct type **CONST_PTR (unknown_builtin_types[]) =
1302 {
1303   0
1304 };
1305 static const struct op_print unk_op_print_tab[] =
1306 {
1307   {NULL, OP_NULL, PREC_NULL, 0}
1308 };
1309
1310 const struct language_defn unknown_language_defn =
1311 {
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 {
1341   "auto",
1342   language_auto,
1343   &unknown_builtin_types[0],
1344   range_check_off,
1345   type_check_off,
1346   unk_lang_parser,
1347   unk_lang_error,
1348   evaluate_subexp_standard,
1349   unk_lang_printchar,           /* Print character constant */
1350   unk_lang_printstr,
1351   unk_lang_emit_char,
1352   unk_lang_create_fundamental_type,
1353   unk_lang_print_type,          /* Print a type using appropriate syntax */
1354   unk_lang_val_print,           /* Print a value using appropriate syntax */
1355   unk_lang_value_print,         /* Print a top-level value */
1356   {"", "", "", ""},             /* Binary format info */
1357   {"0%lo", "0", "o", ""},       /* Octal format info */
1358   {"%ld", "", "d", ""},         /* Decimal format info */
1359   {"0x%lx", "0x", "x", ""},     /* Hex format info */
1360   unk_op_print_tab,             /* expression operators for printing */
1361   1,                            /* c-style arrays */
1362   0,                            /* String lower bound */
1363   &builtin_type_char,           /* Type of string elements */
1364   LANG_MAGIC
1365 };
1366
1367 const struct language_defn local_language_defn =
1368 {
1369   "local",
1370   language_auto,
1371   &unknown_builtin_types[0],
1372   range_check_off,
1373   type_check_off,
1374   unk_lang_parser,
1375   unk_lang_error,
1376   evaluate_subexp_standard,
1377   unk_lang_printchar,           /* Print character constant */
1378   unk_lang_printstr,
1379   unk_lang_emit_char,
1380   unk_lang_create_fundamental_type,
1381   unk_lang_print_type,          /* Print a type using appropriate syntax */
1382   unk_lang_val_print,           /* Print a value using appropriate syntax */
1383   unk_lang_value_print,         /* Print a top-level value */
1384   {"", "", "", ""},             /* Binary format info */
1385   {"0%lo", "0", "o", ""},       /* Octal format info */
1386   {"%ld", "", "d", ""},         /* Decimal format info */
1387   {"0x%lx", "0x", "x", ""},     /* Hex format info */
1388   unk_op_print_tab,             /* expression operators for printing */
1389   1,                            /* c-style arrays */
1390   0,                            /* String lower bound */
1391   &builtin_type_char,           /* Type of string elements */
1392   LANG_MAGIC
1393 };
1394 \f
1395 /* Initialize the language routines */
1396
1397 void
1398 _initialize_language ()
1399 {
1400   struct cmd_list_element *set, *show;
1401
1402   /* GDB commands for language specific stuff */
1403
1404   set = add_set_cmd ("language", class_support, var_string_noescape,
1405                      (char *) &language,
1406                      "Set the current source language.",
1407                      &setlist);
1408   show = add_show_from_set (set, &showlist);
1409   set->function.cfunc = set_language_command;
1410   show->function.cfunc = show_language_command;
1411
1412   add_prefix_cmd ("check", no_class, set_check,
1413                   "Set the status of the type/range checker",
1414                   &setchecklist, "set check ", 0, &setlist);
1415   add_alias_cmd ("c", "check", no_class, 1, &setlist);
1416   add_alias_cmd ("ch", "check", no_class, 1, &setlist);
1417
1418   add_prefix_cmd ("check", no_class, show_check,
1419                   "Show the status of the type/range checker",
1420                   &showchecklist, "show check ", 0, &showlist);
1421   add_alias_cmd ("c", "check", no_class, 1, &showlist);
1422   add_alias_cmd ("ch", "check", no_class, 1, &showlist);
1423
1424   set = add_set_cmd ("type", class_support, var_string_noescape,
1425                      (char *) &type,
1426                      "Set type checking.  (on/warn/off/auto)",
1427                      &setchecklist);
1428   show = add_show_from_set (set, &showchecklist);
1429   set->function.cfunc = set_type_command;
1430   show->function.cfunc = show_type_command;
1431
1432   set = add_set_cmd ("range", class_support, var_string_noescape,
1433                      (char *) &range,
1434                      "Set range checking.  (on/warn/off/auto)",
1435                      &setchecklist);
1436   show = add_show_from_set (set, &showchecklist);
1437   set->function.cfunc = set_range_command;
1438   show->function.cfunc = show_range_command;
1439
1440   add_language (&unknown_language_defn);
1441   add_language (&local_language_defn);
1442   add_language (&auto_language_defn);
1443
1444   language = savestring ("auto", strlen ("auto"));
1445   range = savestring ("auto", strlen ("auto"));
1446   type = savestring ("auto", strlen ("auto"));
1447
1448   /* Have the above take effect */
1449
1450   set_language_command (language, 0);
1451   set_type_command (NULL, 0);
1452   set_range_command (NULL, 0);
1453 }