gdb/eval.c

   1 /* Evaluate expressions for GDB.
   2
   3    Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995,
   4    1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006, 2007, 2008
   5    Free Software Foundation, Inc.
   6
   7    This file is part of GDB.
   8
   9    This program is free software; you can redistribute it and/or modify
  10    it under the terms of the GNU General Public License as published by
  11    the Free Software Foundation; either version 3 of the License, or
  12    (at your option) any later version.
  13
  14    This program is distributed in the hope that it will be useful,
  15    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17    GNU General Public License for more details.
  18
  19    You should have received a copy of the GNU General Public License
  20    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  21
  22 #include "defs.h"
  23 #include "gdb_string.h"
  24 #include "symtab.h"
  25 #include "gdbtypes.h"
  26 #include "value.h"
  27 #include "expression.h"
  28 #include "target.h"
  29 #include "frame.h"
  30 #include "language.h"           /* For CAST_IS_CONVERSION */
  31 #include "f-lang.h"             /* for array bound stuff */
  32 #include "cp-abi.h"
  33 #include "infcall.h"
  34 #include "objc-lang.h"
  35 #include "block.h"
  36 #include "parser-defs.h"
  37 #include "cp-support.h"
  38 #include "ui-out.h"
  39 #include "exceptions.h"
  40 #include "regcache.h"
  41 #include "user-regs.h"
  42
  43 #include "gdb_assert.h"
  44
  45 /* This is defined in valops.c */
  46 extern int overload_resolution;
  47
  48 /* JYG: lookup rtti type of STRUCTOP_PTR when this is set to continue
  49    on with successful lookup for member/method of the rtti type. */
  50 extern int objectprint;
  51
  52 /* Prototypes for local functions. */
  53
  54 static struct value *evaluate_subexp_for_sizeof (struct expression *, int *);
  55
  56 static struct value *evaluate_subexp_for_address (struct expression *,
  57                                                   int *, enum noside);
  58
  59 static struct value *evaluate_subexp (struct type *, struct expression *,
  60                                       int *, enum noside);
  61
  62 static char *get_label (struct expression *, int *);
  63
  64 static struct value *evaluate_struct_tuple (struct value *,
  65                                             struct expression *, int *,
  66                                             enum noside, int);
  67
  68 static LONGEST init_array_element (struct value *, struct value *,
  69                                    struct expression *, int *, enum noside,
  70                                    LONGEST, LONGEST);
  71
  72 static struct value *
  73 evaluate_subexp (struct type *expect_type, struct expression *exp,
  74                  int *pos, enum noside noside)
  75 {
  76   return (*exp->language_defn->la_exp_desc->evaluate_exp)
  77     (expect_type, exp, pos, noside);
  78 }
  79 \f
  80 /* Parse the string EXP as a C expression, evaluate it,
  81    and return the result as a number.  */
  82
  83 CORE_ADDR
  84 parse_and_eval_address (char *exp)
  85 {
  86   struct expression *expr = parse_expression (exp);
  87   CORE_ADDR addr;
  88   struct cleanup *old_chain =
  89     make_cleanup (free_current_contents, &expr);
  90
  91   addr = value_as_address (evaluate_expression (expr));
  92   do_cleanups (old_chain);
  93   return addr;
  94 }
  95
  96 /* Like parse_and_eval_address but takes a pointer to a char * variable
  97    and advanced that variable across the characters parsed.  */
  98
  99 CORE_ADDR
 100 parse_and_eval_address_1 (char **expptr)
 101 {
 102   struct expression *expr = parse_exp_1 (expptr, (struct block *) 0, 0);
 103   CORE_ADDR addr;
 104   struct cleanup *old_chain =
 105     make_cleanup (free_current_contents, &expr);
 106
 107   addr = value_as_address (evaluate_expression (expr));
 108   do_cleanups (old_chain);
 109   return addr;
 110 }
 111
 112 /* Like parse_and_eval_address, but treats the value of the expression
 113    as an integer, not an address, returns a LONGEST, not a CORE_ADDR */
 114 LONGEST
 115 parse_and_eval_long (char *exp)
 116 {
 117   struct expression *expr = parse_expression (exp);
 118   LONGEST retval;
 119   struct cleanup *old_chain =
 120     make_cleanup (free_current_contents, &expr);
 121
 122   retval = value_as_long (evaluate_expression (expr));
 123   do_cleanups (old_chain);
 124   return (retval);
 125 }
 126
 127 struct value *
 128 parse_and_eval (char *exp)
 129 {
 130   struct expression *expr = parse_expression (exp);
 131   struct value *val;
 132   struct cleanup *old_chain =
 133     make_cleanup (free_current_contents, &expr);
 134
 135   val = evaluate_expression (expr);
 136   do_cleanups (old_chain);
 137   return val;
 138 }
 139
 140 /* Parse up to a comma (or to a closeparen)
 141    in the string EXPP as an expression, evaluate it, and return the value.
 142    EXPP is advanced to point to the comma.  */
 143
 144 struct value *
 145 parse_to_comma_and_eval (char **expp)
 146 {
 147   struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
 148   struct value *val;
 149   struct cleanup *old_chain =
 150     make_cleanup (free_current_contents, &expr);
 151
 152   val = evaluate_expression (expr);
 153   do_cleanups (old_chain);
 154   return val;
 155 }
 156 \f
 157 /* Evaluate an expression in internal prefix form
 158    such as is constructed by parse.y.
 159
 160    See expression.h for info on the format of an expression.  */
 161
 162 struct value *
 163 evaluate_expression (struct expression *exp)
 164 {
 165   int pc = 0;
 166   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
 167 }
 168
 169 /* Evaluate an expression, avoiding all memory references
 170    and getting a value whose type alone is correct.  */
 171
 172 struct value *
 173 evaluate_type (struct expression *exp)
 174 {
 175   int pc = 0;
 176   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
 177 }
 178
 179 /* Evaluate a subexpression, avoiding all memory references and
 180    getting a value whose type alone is correct.  */
 181
 182 struct value *
 183 evaluate_subexpression_type (struct expression *exp, int subexp)
 184 {
 185   return evaluate_subexp (NULL_TYPE, exp, &subexp, EVAL_AVOID_SIDE_EFFECTS);
 186 }
 187
 188 /* Extract a field operation from an expression.  If the subexpression
 189    of EXP starting at *SUBEXP is not a structure dereference
 190    operation, return NULL.  Otherwise, return the name of the
 191    dereferenced field, and advance *SUBEXP to point to the
 192    subexpression of the left-hand-side of the dereference.  This is
 193    used when completing field names.  */
 194
 195 char *
 196 extract_field_op (struct expression *exp, int *subexp)
 197 {
 198   int tem;
 199   char *result;
 200   if (exp->elts[*subexp].opcode != STRUCTOP_STRUCT
 201       && exp->elts[*subexp].opcode != STRUCTOP_PTR)
 202     return NULL;
 203   tem = longest_to_int (exp->elts[*subexp + 1].longconst);
 204   result = &exp->elts[*subexp + 2].string;
 205   (*subexp) += 1 + 3 + BYTES_TO_EXP_ELEM (tem + 1);
 206   return result;
 207 }
 208
 209 /* If the next expression is an OP_LABELED, skips past it,
 210    returning the label.  Otherwise, does nothing and returns NULL. */
 211
 212 static char *
 213 get_label (struct expression *exp, int *pos)
 214 {
 215   if (exp->elts[*pos].opcode == OP_LABELED)
 216     {
 217       int pc = (*pos)++;
 218       char *name = &exp->elts[pc + 2].string;
 219       int tem = longest_to_int (exp->elts[pc + 1].longconst);
 220       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 221       return name;
 222     }
 223   else
 224     return NULL;
 225 }
 226
 227 /* This function evaluates tuples (in (the deleted) Chill) or
 228    brace-initializers (in C/C++) for structure types.  */
 229
 230 static struct value *
 231 evaluate_struct_tuple (struct value *struct_val,
 232                        struct expression *exp,
 233                        int *pos, enum noside noside, int nargs)
 234 {
 235   struct type *struct_type = check_typedef (value_type (struct_val));
 236   struct type *substruct_type = struct_type;
 237   struct type *field_type;
 238   int fieldno = -1;
 239   int variantno = -1;
 240   int subfieldno = -1;
 241   while (--nargs >= 0)
 242     {
 243       int pc = *pos;
 244       struct value *val = NULL;
 245       int nlabels = 0;
 246       int bitpos, bitsize;
 247       bfd_byte *addr;
 248
 249       /* Skip past the labels, and count them. */
 250       while (get_label (exp, pos) != NULL)
 251         nlabels++;
 252
 253       do
 254         {
 255           char *label = get_label (exp, &pc);
 256           if (label)
 257             {
 258               for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
 259                    fieldno++)
 260                 {
 261                   char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
 262                   if (field_name != NULL && strcmp (field_name, label) == 0)
 263                     {
 264                       variantno = -1;
 265                       subfieldno = fieldno;
 266                       substruct_type = struct_type;
 267                       goto found;
 268                     }
 269                 }
 270               for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type);
 271                    fieldno++)
 272                 {
 273                   char *field_name = TYPE_FIELD_NAME (struct_type, fieldno);
 274                   field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
 275                   if ((field_name == 0 || *field_name == '\0')
 276                       && TYPE_CODE (field_type) == TYPE_CODE_UNION)
 277                     {
 278                       variantno = 0;
 279                       for (; variantno < TYPE_NFIELDS (field_type);
 280                            variantno++)
 281                         {
 282                           substruct_type
 283                             = TYPE_FIELD_TYPE (field_type, variantno);
 284                           if (TYPE_CODE (substruct_type) == TYPE_CODE_STRUCT)
 285                             {
 286                               for (subfieldno = 0;
 287                                  subfieldno < TYPE_NFIELDS (substruct_type);
 288                                    subfieldno++)
 289                                 {
 290                                   if (strcmp(TYPE_FIELD_NAME (substruct_type,
 291                                                               subfieldno),
 292                                              label) == 0)
 293                                     {
 294                                       goto found;
 295                                     }
 296                                 }
 297                             }
 298                         }
 299                     }
 300                 }
 301               error (_("there is no field named %s"), label);
 302             found:
 303               ;
 304             }
 305           else
 306             {
 307               /* Unlabelled tuple element - go to next field. */
 308               if (variantno >= 0)
 309                 {
 310                   subfieldno++;
 311                   if (subfieldno >= TYPE_NFIELDS (substruct_type))
 312                     {
 313                       variantno = -1;
 314                       substruct_type = struct_type;
 315                     }
 316                 }
 317               if (variantno < 0)
 318                 {
 319                   fieldno++;
 320                   /* Skip static fields.  */
 321                   while (fieldno < TYPE_NFIELDS (struct_type)
 322                          && TYPE_FIELD_STATIC_KIND (struct_type, fieldno))
 323                     fieldno++;
 324                   subfieldno = fieldno;
 325                   if (fieldno >= TYPE_NFIELDS (struct_type))
 326                     error (_("too many initializers"));
 327                   field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
 328                   if (TYPE_CODE (field_type) == TYPE_CODE_UNION
 329                       && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
 330                     error (_("don't know which variant you want to set"));
 331                 }
 332             }
 333
 334           /* Here, struct_type is the type of the inner struct,
 335              while substruct_type is the type of the inner struct.
 336              These are the same for normal structures, but a variant struct
 337              contains anonymous union fields that contain substruct fields.
 338              The value fieldno is the index of the top-level (normal or
 339              anonymous union) field in struct_field, while the value
 340              subfieldno is the index of the actual real (named inner) field
 341              in substruct_type. */
 342
 343           field_type = TYPE_FIELD_TYPE (substruct_type, subfieldno);
 344           if (val == 0)
 345             val = evaluate_subexp (field_type, exp, pos, noside);
 346
 347           /* Now actually set the field in struct_val. */
 348
 349           /* Assign val to field fieldno. */
 350           if (value_type (val) != field_type)
 351             val = value_cast (field_type, val);
 352
 353           bitsize = TYPE_FIELD_BITSIZE (substruct_type, subfieldno);
 354           bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
 355           if (variantno >= 0)
 356             bitpos += TYPE_FIELD_BITPOS (substruct_type, subfieldno);
 357           addr = value_contents_writeable (struct_val) + bitpos / 8;
 358           if (bitsize)
 359             modify_field (addr, value_as_long (val),
 360                           bitpos % 8, bitsize);
 361           else
 362             memcpy (addr, value_contents (val),
 363                     TYPE_LENGTH (value_type (val)));
 364         }
 365       while (--nlabels > 0);
 366     }
 367   return struct_val;
 368 }
 369
 370 /* Recursive helper function for setting elements of array tuples for
 371    (the deleted) Chill.  The target is ARRAY (which has bounds
 372    LOW_BOUND to HIGH_BOUND); the element value is ELEMENT; EXP, POS
 373    and NOSIDE are as usual.  Evaluates index expresions and sets the
 374    specified element(s) of ARRAY to ELEMENT.  Returns last index
 375    value.  */
 376
 377 static LONGEST
 378 init_array_element (struct value *array, struct value *element,
 379                     struct expression *exp, int *pos,
 380                     enum noside noside, LONGEST low_bound, LONGEST high_bound)
 381 {
 382   LONGEST index;
 383   int element_size = TYPE_LENGTH (value_type (element));
 384   if (exp->elts[*pos].opcode == BINOP_COMMA)
 385     {
 386       (*pos)++;
 387       init_array_element (array, element, exp, pos, noside,
 388                           low_bound, high_bound);
 389       return init_array_element (array, element,
 390                                  exp, pos, noside, low_bound, high_bound);
 391     }
 392   else if (exp->elts[*pos].opcode == BINOP_RANGE)
 393     {
 394       LONGEST low, high;
 395       (*pos)++;
 396       low = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 397       high = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 398       if (low < low_bound || high > high_bound)
 399         error (_("tuple range index out of range"));
 400       for (index = low; index <= high; index++)
 401         {
 402           memcpy (value_contents_raw (array)
 403                   + (index - low_bound) * element_size,
 404                   value_contents (element), element_size);
 405         }
 406     }
 407   else
 408     {
 409       index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 410       if (index < low_bound || index > high_bound)
 411         error (_("tuple index out of range"));
 412       memcpy (value_contents_raw (array) + (index - low_bound) * element_size,
 413               value_contents (element), element_size);
 414     }
 415   return index;
 416 }
 417
 418 struct value *
 419 value_f90_subarray (struct value *array,
 420                     struct expression *exp, int *pos, enum noside noside)
 421 {
 422   int pc = (*pos) + 1;
 423   LONGEST low_bound, high_bound;
 424   struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
 425   enum f90_range_type range_type = longest_to_int (exp->elts[pc].longconst);
 426
 427   *pos += 3;
 428
 429   if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
 430     low_bound = TYPE_LOW_BOUND (range);
 431   else
 432     low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 433
 434   if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
 435     high_bound = TYPE_HIGH_BOUND (range);
 436   else
 437     high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 438
 439   return value_slice (array, low_bound, high_bound - low_bound + 1);
 440 }
 441
 442
 443 /* Promote value ARG1 as appropriate before performing a unary operation
 444    on this argument.
 445    If the result is not appropriate for any particular language then it
 446    needs to patch this function.  */
 447
 448 void
 449 unop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
 450               struct value **arg1)
 451 {
 452   struct type *type1;
 453
 454   *arg1 = coerce_ref (*arg1);
 455   type1 = check_typedef (value_type (*arg1));
 456
 457   if (is_integral_type (type1))
 458     {
 459       switch (language->la_language)
 460         {
 461         default:
 462           /* Perform integral promotion for ANSI C/C++.
 463              If not appropropriate for any particular language
 464              it needs to modify this function.  */
 465           {
 466             struct type *builtin_int = builtin_type (gdbarch)->builtin_int;
 467             if (TYPE_LENGTH (type1) < TYPE_LENGTH (builtin_int))
 468               *arg1 = value_cast (builtin_int, *arg1);
 469           }
 470           break;
 471         }
 472     }
 473 }
 474
 475 /* Promote values ARG1 and ARG2 as appropriate before performing a binary
 476    operation on those two operands.
 477    If the result is not appropriate for any particular language then it
 478    needs to patch this function.  */
 479
 480 void
 481 binop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
 482                struct value **arg1, struct value **arg2)
 483 {
 484   struct type *promoted_type = NULL;
 485   struct type *type1;
 486   struct type *type2;
 487
 488   *arg1 = coerce_ref (*arg1);
 489   *arg2 = coerce_ref (*arg2);
 490
 491   type1 = check_typedef (value_type (*arg1));
 492   type2 = check_typedef (value_type (*arg2));
 493
 494   if ((TYPE_CODE (type1) != TYPE_CODE_FLT
 495        && TYPE_CODE (type1) != TYPE_CODE_DECFLOAT
 496        && !is_integral_type (type1))
 497       || (TYPE_CODE (type2) != TYPE_CODE_FLT
 498           && TYPE_CODE (type2) != TYPE_CODE_DECFLOAT
 499           && !is_integral_type (type2)))
 500     return;
 501
 502   if (TYPE_CODE (type1) == TYPE_CODE_DECFLOAT
 503       || TYPE_CODE (type2) == TYPE_CODE_DECFLOAT)
 504     {
 505       /* No promotion required.  */
 506     }
 507   else if (TYPE_CODE (type1) == TYPE_CODE_FLT
 508            || TYPE_CODE (type2) == TYPE_CODE_FLT)
 509     {
 510       switch (language->la_language)
 511         {
 512         case language_c:
 513         case language_cplus:
 514         case language_asm:
 515         case language_objc:
 516           /* No promotion required.  */
 517           break;
 518
 519         default:
 520           /* For other languages the result type is unchanged from gdb
 521              version 6.7 for backward compatibility.
 522              If either arg was long double, make sure that value is also long
 523              double.  Otherwise use double.  */
 524           if (TYPE_LENGTH (type1) * 8 > gdbarch_double_bit (gdbarch)
 525               || TYPE_LENGTH (type2) * 8 > gdbarch_double_bit (gdbarch))
 526             promoted_type = builtin_type (gdbarch)->builtin_long_double;
 527           else
 528             promoted_type = builtin_type (gdbarch)->builtin_double;
 529           break;
 530         }
 531     }
 532   else if (TYPE_CODE (type1) == TYPE_CODE_BOOL
 533            && TYPE_CODE (type2) == TYPE_CODE_BOOL)
 534     {
 535       /* No promotion required.  */
 536     }
 537   else
 538     /* Integral operations here.  */
 539     /* FIXME: Also mixed integral/booleans, with result an integer.  */
 540     {
 541       const struct builtin_type *builtin = builtin_type (gdbarch);
 542       unsigned int promoted_len1 = TYPE_LENGTH (type1);
 543       unsigned int promoted_len2 = TYPE_LENGTH (type2);
 544       int is_unsigned1 = TYPE_UNSIGNED (type1);
 545       int is_unsigned2 = TYPE_UNSIGNED (type2);
 546       unsigned int result_len;
 547       int unsigned_operation;
 548
 549       /* Determine type length and signedness after promotion for
 550          both operands.  */
 551       if (promoted_len1 < TYPE_LENGTH (builtin->builtin_int))
 552         {
 553           is_unsigned1 = 0;
 554           promoted_len1 = TYPE_LENGTH (builtin->builtin_int);
 555         }
 556       if (promoted_len2 < TYPE_LENGTH (builtin->builtin_int))
 557         {
 558           is_unsigned2 = 0;
 559           promoted_len2 = TYPE_LENGTH (builtin->builtin_int);
 560         }
 561
 562       if (promoted_len1 > promoted_len2)
 563         {
 564           unsigned_operation = is_unsigned1;
 565           result_len = promoted_len1;
 566         }
 567       else if (promoted_len2 > promoted_len1)
 568         {
 569           unsigned_operation = is_unsigned2;
 570           result_len = promoted_len2;
 571         }
 572       else
 573         {
 574           unsigned_operation = is_unsigned1 || is_unsigned2;
 575           result_len = promoted_len1;
 576         }
 577
 578       switch (language->la_language)
 579         {
 580         case language_c:
 581         case language_cplus:
 582         case language_asm:
 583         case language_objc:
 584           if (result_len <= TYPE_LENGTH (builtin->builtin_int))
 585             {
 586               promoted_type = (unsigned_operation
 587                                ? builtin->builtin_unsigned_int
 588                                : builtin->builtin_int);
 589             }
 590           else if (result_len <= TYPE_LENGTH (builtin->builtin_long))
 591             {
 592               promoted_type = (unsigned_operation
 593                                ? builtin->builtin_unsigned_long
 594                                : builtin->builtin_long);
 595             }
 596           else
 597             {
 598               promoted_type = (unsigned_operation
 599                                ? builtin->builtin_unsigned_long_long
 600                                : builtin->builtin_long_long);
 601             }
 602           break;
 603
 604         default:
 605           /* For other languages the result type is unchanged from gdb
 606              version 6.7 for backward compatibility.
 607              If either arg was long long, make sure that value is also long
 608              long.  Otherwise use long.  */
 609           if (unsigned_operation)
 610             {
 611               if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
 612                 promoted_type = builtin->builtin_unsigned_long_long;
 613               else
 614                 promoted_type = builtin->builtin_unsigned_long;
 615             }
 616           else
 617             {
 618               if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
 619                 promoted_type = builtin->builtin_long_long;
 620               else
 621                 promoted_type = builtin->builtin_long;
 622             }
 623           break;
 624         }
 625     }
 626
 627   if (promoted_type)
 628     {
 629       /* Promote both operands to common type.  */
 630       *arg1 = value_cast (promoted_type, *arg1);
 631       *arg2 = value_cast (promoted_type, *arg2);
 632     }
 633 }
 634
 635 static int
 636 ptrmath_type_p (struct type *type)
 637 {
 638   type = check_typedef (type);
 639   if (TYPE_CODE (type) == TYPE_CODE_REF)
 640     type = TYPE_TARGET_TYPE (type);
 641
 642   switch (TYPE_CODE (type))
 643     {
 644     case TYPE_CODE_PTR:
 645     case TYPE_CODE_FUNC:
 646       return 1;
 647
 648     case TYPE_CODE_ARRAY:
 649       return current_language->c_style_arrays;
 650
 651     default:
 652       return 0;
 653     }
 654 }
 655
 656 struct value *
 657 evaluate_subexp_standard (struct type *expect_type,
 658                           struct expression *exp, int *pos,
 659                           enum noside noside)
 660 {
 661   enum exp_opcode op;
 662   int tem, tem2, tem3;
 663   int pc, pc2 = 0, oldpos;
 664   struct value *arg1 = NULL;
 665   struct value *arg2 = NULL;
 666   struct value *arg3;
 667   struct type *type;
 668   int nargs;
 669   struct value **argvec;
 670   int upper, lower, retcode;
 671   int code;
 672   int ix;
 673   long mem_offset;
 674   struct type **arg_types;
 675   int save_pos1;
 676
 677   pc = (*pos)++;
 678   op = exp->elts[pc].opcode;
 679
 680   switch (op)
 681     {
 682     case OP_SCOPE:
 683       tem = longest_to_int (exp->elts[pc + 2].longconst);
 684       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
 685       if (noside == EVAL_SKIP)
 686         goto nosideret;
 687       arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
 688                                   &exp->elts[pc + 3].string,
 689                                   0, noside);
 690       if (arg1 == NULL)
 691         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
 692       return arg1;
 693
 694     case OP_LONG:
 695       (*pos) += 3;
 696       return value_from_longest (exp->elts[pc + 1].type,
 697                                  exp->elts[pc + 2].longconst);
 698
 699     case OP_DOUBLE:
 700       (*pos) += 3;
 701       return value_from_double (exp->elts[pc + 1].type,
 702                                 exp->elts[pc + 2].doubleconst);
 703
 704     case OP_DECFLOAT:
 705       (*pos) += 3;
 706       return value_from_decfloat (exp->elts[pc + 1].type,
 707                                   exp->elts[pc + 2].decfloatconst);
 708
 709     case OP_VAR_VALUE:
 710       (*pos) += 3;
 711       if (noside == EVAL_SKIP)
 712         goto nosideret;
 713
 714       /* JYG: We used to just return value_zero of the symbol type
 715          if we're asked to avoid side effects.  Otherwise we return
 716          value_of_variable (...).  However I'm not sure if
 717          value_of_variable () has any side effect.
 718          We need a full value object returned here for whatis_exp ()
 719          to call evaluate_type () and then pass the full value to
 720          value_rtti_target_type () if we are dealing with a pointer
 721          or reference to a base class and print object is on. */
 722
 723       {
 724         volatile struct gdb_exception except;
 725         struct value *ret = NULL;
 726
 727         TRY_CATCH (except, RETURN_MASK_ERROR)
 728           {
 729             ret = value_of_variable (exp->elts[pc + 2].symbol,
 730                                      exp->elts[pc + 1].block);
 731           }
 732
 733         if (except.reason < 0)
 734           {
 735             if (noside == EVAL_AVOID_SIDE_EFFECTS)
 736               ret = value_zero (SYMBOL_TYPE (exp->elts[pc + 2].symbol), not_lval);
 737             else
 738               throw_exception (except);
 739           }
 740
 741         return ret;
 742       }
 743
 744     case OP_LAST:
 745       (*pos) += 2;
 746       return
 747         access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
 748
 749     case OP_REGISTER:
 750       {
 751         const char *name = &exp->elts[pc + 2].string;
 752         int regno;
 753         struct value *val;
 754
 755         (*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
 756         regno = user_reg_map_name_to_regnum (current_gdbarch,
 757                                              name, strlen (name));
 758         if (regno == -1)
 759           error (_("Register $%s not available."), name);
 760
 761         /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
 762            a value with the appropriate register type.  Unfortunately,
 763            we don't have easy access to the type of user registers.
 764            So for these registers, we fetch the register value regardless
 765            of the evaluation mode.  */
 766         if (noside == EVAL_AVOID_SIDE_EFFECTS
 767             && regno < gdbarch_num_regs (current_gdbarch)
 768                + gdbarch_num_pseudo_regs (current_gdbarch))
 769           val = value_zero (register_type (current_gdbarch, regno), not_lval);
 770         else
 771           val = value_of_register (regno, get_selected_frame (NULL));
 772         if (val == NULL)
 773           error (_("Value of register %s not available."), name);
 774         else
 775           return val;
 776       }
 777     case OP_BOOL:
 778       (*pos) += 2;
 779       type = language_bool_type (exp->language_defn, exp->gdbarch);
 780       return value_from_longest (type, exp->elts[pc + 1].longconst);
 781
 782     case OP_INTERNALVAR:
 783       (*pos) += 2;
 784       return value_of_internalvar (exp->elts[pc + 1].internalvar);
 785
 786     case OP_STRING:
 787       tem = longest_to_int (exp->elts[pc + 1].longconst);
 788       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 789       if (noside == EVAL_SKIP)
 790         goto nosideret;
 791       return value_string (&exp->elts[pc + 2].string, tem);
 792
 793     case OP_OBJC_NSSTRING:              /* Objective C Foundation Class NSString constant.  */
 794       tem = longest_to_int (exp->elts[pc + 1].longconst);
 795       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
 796       if (noside == EVAL_SKIP)
 797         {
 798           goto nosideret;
 799         }
 800       return (struct value *) value_nsstring (&exp->elts[pc + 2].string, tem + 1);
 801
 802     case OP_BITSTRING:
 803       tem = longest_to_int (exp->elts[pc + 1].longconst);
 804       (*pos)
 805         += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
 806       if (noside == EVAL_SKIP)
 807         goto nosideret;
 808       return value_bitstring (&exp->elts[pc + 2].string, tem);
 809       break;
 810
 811     case OP_ARRAY:
 812       (*pos) += 3;
 813       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
 814       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
 815       nargs = tem3 - tem2 + 1;
 816       type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
 817
 818       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 819           && TYPE_CODE (type) == TYPE_CODE_STRUCT)
 820         {
 821           struct value *rec = allocate_value (expect_type);
 822           memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
 823           return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
 824         }
 825
 826       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 827           && TYPE_CODE (type) == TYPE_CODE_ARRAY)
 828         {
 829           struct type *range_type = TYPE_FIELD_TYPE (type, 0);
 830           struct type *element_type = TYPE_TARGET_TYPE (type);
 831           struct value *array = allocate_value (expect_type);
 832           int element_size = TYPE_LENGTH (check_typedef (element_type));
 833           LONGEST low_bound, high_bound, index;
 834           if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 835             {
 836               low_bound = 0;
 837               high_bound = (TYPE_LENGTH (type) / element_size) - 1;
 838             }
 839           index = low_bound;
 840           memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
 841           for (tem = nargs; --nargs >= 0;)
 842             {
 843               struct value *element;
 844               int index_pc = 0;
 845               if (exp->elts[*pos].opcode == BINOP_RANGE)
 846                 {
 847                   index_pc = ++(*pos);
 848                   evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 849                 }
 850               element = evaluate_subexp (element_type, exp, pos, noside);
 851               if (value_type (element) != element_type)
 852                 element = value_cast (element_type, element);
 853               if (index_pc)
 854                 {
 855                   int continue_pc = *pos;
 856                   *pos = index_pc;
 857                   index = init_array_element (array, element, exp, pos, noside,
 858                                               low_bound, high_bound);
 859                   *pos = continue_pc;
 860                 }
 861               else
 862                 {
 863                   if (index > high_bound)
 864                     /* to avoid memory corruption */
 865                     error (_("Too many array elements"));
 866                   memcpy (value_contents_raw (array)
 867                           + (index - low_bound) * element_size,
 868                           value_contents (element),
 869                           element_size);
 870                 }
 871               index++;
 872             }
 873           return array;
 874         }
 875
 876       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
 877           && TYPE_CODE (type) == TYPE_CODE_SET)
 878         {
 879           struct value *set = allocate_value (expect_type);
 880           gdb_byte *valaddr = value_contents_raw (set);
 881           struct type *element_type = TYPE_INDEX_TYPE (type);
 882           struct type *check_type = element_type;
 883           LONGEST low_bound, high_bound;
 884
 885           /* get targettype of elementtype */
 886           while (TYPE_CODE (check_type) == TYPE_CODE_RANGE ||
 887                  TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
 888             check_type = TYPE_TARGET_TYPE (check_type);
 889
 890           if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
 891             error (_("(power)set type with unknown size"));
 892           memset (valaddr, '\0', TYPE_LENGTH (type));
 893           for (tem = 0; tem < nargs; tem++)
 894             {
 895               LONGEST range_low, range_high;
 896               struct type *range_low_type, *range_high_type;
 897               struct value *elem_val;
 898               if (exp->elts[*pos].opcode == BINOP_RANGE)
 899                 {
 900                   (*pos)++;
 901                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 902                   range_low_type = value_type (elem_val);
 903                   range_low = value_as_long (elem_val);
 904                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 905                   range_high_type = value_type (elem_val);
 906                   range_high = value_as_long (elem_val);
 907                 }
 908               else
 909                 {
 910                   elem_val = evaluate_subexp (element_type, exp, pos, noside);
 911                   range_low_type = range_high_type = value_type (elem_val);
 912                   range_low = range_high = value_as_long (elem_val);
 913                 }
 914               /* check types of elements to avoid mixture of elements from
 915                  different types. Also check if type of element is "compatible"
 916                  with element type of powerset */
 917               if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
 918                 range_low_type = TYPE_TARGET_TYPE (range_low_type);
 919               if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
 920                 range_high_type = TYPE_TARGET_TYPE (range_high_type);
 921               if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type)) ||
 922                   (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM &&
 923                    (range_low_type != range_high_type)))
 924                 /* different element modes */
 925                 error (_("POWERSET tuple elements of different mode"));
 926               if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type)) ||
 927                   (TYPE_CODE (check_type) == TYPE_CODE_ENUM &&
 928                    range_low_type != check_type))
 929                 error (_("incompatible POWERSET tuple elements"));
 930               if (range_low > range_high)
 931                 {
 932                   warning (_("empty POWERSET tuple range"));
 933                   continue;
 934                 }
 935               if (range_low < low_bound || range_high > high_bound)
 936                 error (_("POWERSET tuple element out of range"));
 937               range_low -= low_bound;
 938               range_high -= low_bound;
 939               for (; range_low <= range_high; range_low++)
 940                 {
 941                   int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
 942                   if (gdbarch_bits_big_endian (current_gdbarch))
 943                     bit_index = TARGET_CHAR_BIT - 1 - bit_index;
 944                   valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
 945                     |= 1 << bit_index;
 946                 }
 947             }
 948           return set;
 949         }
 950
 951       argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
 952       for (tem = 0; tem < nargs; tem++)
 953         {
 954           /* Ensure that array expressions are coerced into pointer objects. */
 955           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 956         }
 957       if (noside == EVAL_SKIP)
 958         goto nosideret;
 959       return value_array (tem2, tem3, argvec);
 960
 961     case TERNOP_SLICE:
 962       {
 963         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 964         int lowbound
 965         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 966         int upper
 967         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 968         if (noside == EVAL_SKIP)
 969           goto nosideret;
 970         return value_slice (array, lowbound, upper - lowbound + 1);
 971       }
 972
 973     case TERNOP_SLICE_COUNT:
 974       {
 975         struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 976         int lowbound
 977         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 978         int length
 979         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 980         return value_slice (array, lowbound, length);
 981       }
 982
 983     case TERNOP_COND:
 984       /* Skip third and second args to evaluate the first one.  */
 985       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 986       if (value_logical_not (arg1))
 987         {
 988           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 989           return evaluate_subexp (NULL_TYPE, exp, pos, noside);
 990         }
 991       else
 992         {
 993           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 994           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
 995           return arg2;
 996         }
 997
 998     case OP_OBJC_SELECTOR:
 999       {                         /* Objective C @selector operator.  */
1000         char *sel = &exp->elts[pc + 2].string;
1001         int len = longest_to_int (exp->elts[pc + 1].longconst);
1002         struct type *selector_type;
1003
1004         (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1005         if (noside == EVAL_SKIP)
1006           goto nosideret;
1007
1008         if (sel[len] != 0)
1009           sel[len] = 0;         /* Make sure it's terminated.  */
1010
1011         selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1012         return value_from_longest (selector_type, lookup_child_selector (sel));
1013       }
1014
1015     case OP_OBJC_MSGCALL:
1016       {                         /* Objective C message (method) call.  */
1017
1018         static CORE_ADDR responds_selector = 0;
1019         static CORE_ADDR method_selector = 0;
1020
1021         CORE_ADDR selector = 0;
1022
1023         int struct_return = 0;
1024         int sub_no_side = 0;
1025
1026         static struct value *msg_send = NULL;
1027         static struct value *msg_send_stret = NULL;
1028         static int gnu_runtime = 0;
1029
1030         struct value *target = NULL;
1031         struct value *method = NULL;
1032         struct value *called_method = NULL;
1033
1034         struct type *selector_type = NULL;
1035         struct type *long_type;
1036
1037         struct value *ret = NULL;
1038         CORE_ADDR addr = 0;
1039
1040         selector = exp->elts[pc + 1].longconst;
1041         nargs = exp->elts[pc + 2].longconst;
1042         argvec = (struct value **) alloca (sizeof (struct value *)
1043                                            * (nargs + 5));
1044
1045         (*pos) += 3;
1046
1047         long_type = builtin_type (exp->gdbarch)->builtin_long;
1048         selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1049
1050         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1051           sub_no_side = EVAL_NORMAL;
1052         else
1053           sub_no_side = noside;
1054
1055         target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1056
1057         if (value_as_long (target) == 0)
1058           return value_from_longest (long_type, 0);
1059
1060         if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0))
1061           gnu_runtime = 1;
1062
1063         /* Find the method dispatch (Apple runtime) or method lookup
1064            (GNU runtime) function for Objective-C.  These will be used
1065            to lookup the symbol information for the method.  If we
1066            can't find any symbol information, then we'll use these to
1067            call the method, otherwise we can call the method
1068            directly. The msg_send_stret function is used in the special
1069            case of a method that returns a structure (Apple runtime
1070            only).  */
1071         if (gnu_runtime)
1072           {
1073             struct type *type = selector_type;
1074             type = lookup_function_type (type);
1075             type = lookup_pointer_type (type);
1076             type = lookup_function_type (type);
1077             type = lookup_pointer_type (type);
1078
1079             msg_send = find_function_in_inferior ("objc_msg_lookup");
1080             msg_send_stret = find_function_in_inferior ("objc_msg_lookup");
1081
1082             msg_send = value_from_pointer (type, value_as_address (msg_send));
1083             msg_send_stret = value_from_pointer (type,
1084                                         value_as_address (msg_send_stret));
1085           }
1086         else
1087           {
1088             msg_send = find_function_in_inferior ("objc_msgSend");
1089             /* Special dispatcher for methods returning structs */
1090             msg_send_stret = find_function_in_inferior ("objc_msgSend_stret");
1091           }
1092
1093         /* Verify the target object responds to this method. The
1094            standard top-level 'Object' class uses a different name for
1095            the verification method than the non-standard, but more
1096            often used, 'NSObject' class. Make sure we check for both. */
1097
1098         responds_selector = lookup_child_selector ("respondsToSelector:");
1099         if (responds_selector == 0)
1100           responds_selector = lookup_child_selector ("respondsTo:");
1101
1102         if (responds_selector == 0)
1103           error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
1104
1105         method_selector = lookup_child_selector ("methodForSelector:");
1106         if (method_selector == 0)
1107           method_selector = lookup_child_selector ("methodFor:");
1108
1109         if (method_selector == 0)
1110           error (_("no 'methodFor:' or 'methodForSelector:' method"));
1111
1112         /* Call the verification method, to make sure that the target
1113          class implements the desired method. */
1114
1115         argvec[0] = msg_send;
1116         argvec[1] = target;
1117         argvec[2] = value_from_longest (long_type, responds_selector);
1118         argvec[3] = value_from_longest (long_type, selector);
1119         argvec[4] = 0;
1120
1121         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1122         if (gnu_runtime)
1123           {
1124             /* Function objc_msg_lookup returns a pointer.  */
1125             argvec[0] = ret;
1126             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1127           }
1128         if (value_as_long (ret) == 0)
1129           error (_("Target does not respond to this message selector."));
1130
1131         /* Call "methodForSelector:" method, to get the address of a
1132            function method that implements this selector for this
1133            class.  If we can find a symbol at that address, then we
1134            know the return type, parameter types etc.  (that's a good
1135            thing). */
1136
1137         argvec[0] = msg_send;
1138         argvec[1] = target;
1139         argvec[2] = value_from_longest (long_type, method_selector);
1140         argvec[3] = value_from_longest (long_type, selector);
1141         argvec[4] = 0;
1142
1143         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1144         if (gnu_runtime)
1145           {
1146             argvec[0] = ret;
1147             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1148           }
1149
1150         /* ret should now be the selector.  */
1151
1152         addr = value_as_long (ret);
1153         if (addr)
1154           {
1155             struct symbol *sym = NULL;
1156             /* Is it a high_level symbol?  */
1157
1158             sym = find_pc_function (addr);
1159             if (sym != NULL)
1160               method = value_of_variable (sym, 0);
1161           }
1162
1163         /* If we found a method with symbol information, check to see
1164            if it returns a struct.  Otherwise assume it doesn't.  */
1165
1166         if (method)
1167           {
1168             struct block *b;
1169             CORE_ADDR funaddr;
1170             struct type *val_type;
1171
1172             funaddr = find_function_addr (method, &val_type);
1173
1174             b = block_for_pc (funaddr);
1175
1176             CHECK_TYPEDEF (val_type);
1177
1178             if ((val_type == NULL)
1179                 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
1180               {
1181                 if (expect_type != NULL)
1182                   val_type = expect_type;
1183               }
1184
1185             struct_return = using_struct_return (value_type (method), val_type);
1186           }
1187         else if (expect_type != NULL)
1188           {
1189             struct_return = using_struct_return (NULL,
1190                                                  check_typedef (expect_type));
1191           }
1192
1193         /* Found a function symbol.  Now we will substitute its
1194            value in place of the message dispatcher (obj_msgSend),
1195            so that we call the method directly instead of thru
1196            the dispatcher.  The main reason for doing this is that
1197            we can now evaluate the return value and parameter values
1198            according to their known data types, in case we need to
1199            do things like promotion, dereferencing, special handling
1200            of structs and doubles, etc.
1201
1202            We want to use the type signature of 'method', but still
1203            jump to objc_msgSend() or objc_msgSend_stret() to better
1204            mimic the behavior of the runtime.  */
1205
1206         if (method)
1207           {
1208             if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
1209               error (_("method address has symbol information with non-function type; skipping"));
1210             if (struct_return)
1211               VALUE_ADDRESS (method) = value_as_address (msg_send_stret);
1212             else
1213               VALUE_ADDRESS (method) = value_as_address (msg_send);
1214             called_method = method;
1215           }
1216         else
1217           {
1218             if (struct_return)
1219               called_method = msg_send_stret;
1220             else
1221               called_method = msg_send;
1222           }
1223
1224         if (noside == EVAL_SKIP)
1225           goto nosideret;
1226
1227         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1228           {
1229             /* If the return type doesn't look like a function type,
1230                call an error.  This can happen if somebody tries to
1231                turn a variable into a function call. This is here
1232                because people often want to call, eg, strcmp, which
1233                gdb doesn't know is a function.  If gdb isn't asked for
1234                it's opinion (ie. through "whatis"), it won't offer
1235                it. */
1236
1237             struct type *type = value_type (called_method);
1238             if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1239               type = TYPE_TARGET_TYPE (type);
1240             type = TYPE_TARGET_TYPE (type);
1241
1242             if (type)
1243             {
1244               if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1245                 return allocate_value (expect_type);
1246               else
1247                 return allocate_value (type);
1248             }
1249             else
1250               error (_("Expression of type other than \"method returning ...\" used as a method"));
1251           }
1252
1253         /* Now depending on whether we found a symbol for the method,
1254            we will either call the runtime dispatcher or the method
1255            directly.  */
1256
1257         argvec[0] = called_method;
1258         argvec[1] = target;
1259         argvec[2] = value_from_longest (long_type, selector);
1260         /* User-supplied arguments.  */
1261         for (tem = 0; tem < nargs; tem++)
1262           argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1263         argvec[tem + 3] = 0;
1264
1265         if (gnu_runtime && (method != NULL))
1266           {
1267             /* Function objc_msg_lookup returns a pointer.  */
1268             deprecated_set_value_type (argvec[0],
1269                                        lookup_function_type (lookup_pointer_type (value_type (argvec[0]))));
1270             argvec[0] = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1271           }
1272
1273         ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1274         return ret;
1275       }
1276       break;
1277
1278     case OP_FUNCALL:
1279       (*pos) += 2;
1280       op = exp->elts[*pos].opcode;
1281       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1282       /* Allocate arg vector, including space for the function to be
1283          called in argvec[0] and a terminating NULL */
1284       argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
1285       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1286         {
1287           nargs++;
1288           /* First, evaluate the structure into arg2 */
1289           pc2 = (*pos)++;
1290
1291           if (noside == EVAL_SKIP)
1292             goto nosideret;
1293
1294           if (op == STRUCTOP_MEMBER)
1295             {
1296               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1297             }
1298           else
1299             {
1300               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1301             }
1302
1303           /* If the function is a virtual function, then the
1304              aggregate value (providing the structure) plays
1305              its part by providing the vtable.  Otherwise,
1306              it is just along for the ride: call the function
1307              directly.  */
1308
1309           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1310
1311           if (TYPE_CODE (check_typedef (value_type (arg1)))
1312               != TYPE_CODE_METHODPTR)
1313             error (_("Non-pointer-to-member value used in pointer-to-member "
1314                      "construct"));
1315
1316           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1317             {
1318               struct type *method_type = check_typedef (value_type (arg1));
1319               arg1 = value_zero (method_type, not_lval);
1320             }
1321           else
1322             arg1 = cplus_method_ptr_to_value (&arg2, arg1);
1323
1324           /* Now, say which argument to start evaluating from */
1325           tem = 2;
1326         }
1327       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1328         {
1329           /* Hair for method invocations */
1330           int tem2;
1331
1332           nargs++;
1333           /* First, evaluate the structure into arg2 */
1334           pc2 = (*pos)++;
1335           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1336           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1337           if (noside == EVAL_SKIP)
1338             goto nosideret;
1339
1340           if (op == STRUCTOP_STRUCT)
1341             {
1342               /* If v is a variable in a register, and the user types
1343                  v.method (), this will produce an error, because v has
1344                  no address.
1345
1346                  A possible way around this would be to allocate a
1347                  copy of the variable on the stack, copy in the
1348                  contents, call the function, and copy out the
1349                  contents.  I.e. convert this from call by reference
1350                  to call by copy-return (or whatever it's called).
1351                  However, this does not work because it is not the
1352                  same: the method being called could stash a copy of
1353                  the address, and then future uses through that address
1354                  (after the method returns) would be expected to
1355                  use the variable itself, not some copy of it.  */
1356               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1357             }
1358           else
1359             {
1360               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1361             }
1362           /* Now, say which argument to start evaluating from */
1363           tem = 2;
1364         }
1365       else
1366         {
1367           /* Non-method function call */
1368           save_pos1 = *pos;
1369           argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1370           tem = 1;
1371           type = value_type (argvec[0]);
1372           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1373             type = TYPE_TARGET_TYPE (type);
1374           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1375             {
1376               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1377                 {
1378                   /* pai: FIXME This seems to be coercing arguments before
1379                    * overload resolution has been done! */
1380                   argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
1381                                                  exp, pos, noside);
1382                 }
1383             }
1384         }
1385
1386       /* Evaluate arguments */
1387       for (; tem <= nargs; tem++)
1388         {
1389           /* Ensure that array expressions are coerced into pointer objects. */
1390           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1391         }
1392
1393       /* signal end of arglist */
1394       argvec[tem] = 0;
1395
1396       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1397         {
1398           int static_memfuncp;
1399           char tstr[256];
1400
1401           /* Method invocation : stuff "this" as first parameter */
1402           argvec[1] = arg2;
1403           /* Name of method from expression */
1404           strcpy (tstr, &exp->elts[pc2 + 2].string);
1405
1406           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1407             {
1408               /* Language is C++, do some overload resolution before evaluation */
1409               struct value *valp = NULL;
1410
1411               /* Prepare list of argument types for overload resolution */
1412               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1413               for (ix = 1; ix <= nargs; ix++)
1414                 arg_types[ix - 1] = value_type (argvec[ix]);
1415
1416               (void) find_overload_match (arg_types, nargs, tstr,
1417                                      1 /* method */ , 0 /* strict match */ ,
1418                                           &arg2 /* the object */ , NULL,
1419                                           &valp, NULL, &static_memfuncp);
1420
1421
1422               argvec[1] = arg2; /* the ``this'' pointer */
1423               argvec[0] = valp; /* use the method found after overload resolution */
1424             }
1425           else
1426             /* Non-C++ case -- or no overload resolution */
1427             {
1428               struct value *temp = arg2;
1429               argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1430                                             &static_memfuncp,
1431                                             op == STRUCTOP_STRUCT
1432                                        ? "structure" : "structure pointer");
1433               /* value_struct_elt updates temp with the correct value
1434                  of the ``this'' pointer if necessary, so modify argvec[1] to
1435                  reflect any ``this'' changes.  */
1436               arg2 = value_from_longest (lookup_pointer_type(value_type (temp)),
1437                                          VALUE_ADDRESS (temp) + value_offset (temp)
1438                                          + value_embedded_offset (temp));
1439               argvec[1] = arg2; /* the ``this'' pointer */
1440             }
1441
1442           if (static_memfuncp)
1443             {
1444               argvec[1] = argvec[0];
1445               nargs--;
1446               argvec++;
1447             }
1448         }
1449       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1450         {
1451           argvec[1] = arg2;
1452           argvec[0] = arg1;
1453         }
1454       else if (op == OP_VAR_VALUE)
1455         {
1456           /* Non-member function being called */
1457           /* fn: This can only be done for C++ functions.  A C-style function
1458              in a C++ program, for instance, does not have the fields that
1459              are expected here */
1460
1461           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1462             {
1463               /* Language is C++, do some overload resolution before evaluation */
1464               struct symbol *symp;
1465
1466               /* Prepare list of argument types for overload resolution */
1467               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1468               for (ix = 1; ix <= nargs; ix++)
1469                 arg_types[ix - 1] = value_type (argvec[ix]);
1470
1471               (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
1472                                  0 /* not method */ , 0 /* strict match */ ,
1473                       NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
1474                                           NULL, &symp, NULL);
1475
1476               /* Now fix the expression being evaluated */
1477               exp->elts[save_pos1+2].symbol = symp;
1478               argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1479             }
1480           else
1481             {
1482               /* Not C++, or no overload resolution allowed */
1483               /* nothing to be done; argvec already correctly set up */
1484             }
1485         }
1486       else
1487         {
1488           /* It is probably a C-style function */
1489           /* nothing to be done; argvec already correctly set up */
1490         }
1491
1492     do_call_it:
1493
1494       if (noside == EVAL_SKIP)
1495         goto nosideret;
1496       if (argvec[0] == NULL)
1497         error (_("Cannot evaluate function -- may be inlined"));
1498       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1499         {
1500           /* If the return type doesn't look like a function type, call an
1501              error.  This can happen if somebody tries to turn a variable into
1502              a function call. This is here because people often want to
1503              call, eg, strcmp, which gdb doesn't know is a function.  If
1504              gdb isn't asked for it's opinion (ie. through "whatis"),
1505              it won't offer it. */
1506
1507           struct type *ftype =
1508           TYPE_TARGET_TYPE (value_type (argvec[0]));
1509
1510           if (ftype)
1511             return allocate_value (TYPE_TARGET_TYPE (value_type (argvec[0])));
1512           else
1513             error (_("Expression of type other than \"Function returning ...\" used as function"));
1514         }
1515       return call_function_by_hand (argvec[0], nargs, argvec + 1);
1516       /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
1517
1518     case OP_F77_UNDETERMINED_ARGLIST:
1519
1520       /* Remember that in F77, functions, substring ops and
1521          array subscript operations cannot be disambiguated
1522          at parse time.  We have made all array subscript operations,
1523          substring operations as well as function calls  come here
1524          and we now have to discover what the heck this thing actually was.
1525          If it is a function, we process just as if we got an OP_FUNCALL. */
1526
1527       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1528       (*pos) += 2;
1529
1530       /* First determine the type code we are dealing with.  */
1531       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1532       type = check_typedef (value_type (arg1));
1533       code = TYPE_CODE (type);
1534
1535       if (code == TYPE_CODE_PTR)
1536         {
1537           /* Fortran always passes variable to subroutines as pointer.
1538              So we need to look into its target type to see if it is
1539              array, string or function.  If it is, we need to switch
1540              to the target value the original one points to.  */
1541           struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1542
1543           if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1544               || TYPE_CODE (target_type) == TYPE_CODE_STRING
1545               || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1546             {
1547               arg1 = value_ind (arg1);
1548               type = check_typedef (value_type (arg1));
1549               code = TYPE_CODE (type);
1550             }
1551         }
1552
1553       switch (code)
1554         {
1555         case TYPE_CODE_ARRAY:
1556           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1557             return value_f90_subarray (arg1, exp, pos, noside);
1558           else
1559             goto multi_f77_subscript;
1560
1561         case TYPE_CODE_STRING:
1562           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1563             return value_f90_subarray (arg1, exp, pos, noside);
1564           else
1565             {
1566               arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1567               return value_subscript (arg1, arg2);
1568             }
1569
1570         case TYPE_CODE_PTR:
1571         case TYPE_CODE_FUNC:
1572           /* It's a function call. */
1573           /* Allocate arg vector, including space for the function to be
1574              called in argvec[0] and a terminating NULL */
1575           argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
1576           argvec[0] = arg1;
1577           tem = 1;
1578           for (; tem <= nargs; tem++)
1579             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1580           argvec[tem] = 0;      /* signal end of arglist */
1581           goto do_call_it;
1582
1583         default:
1584           error (_("Cannot perform substring on this type"));
1585         }
1586
1587     case OP_COMPLEX:
1588       /* We have a complex number, There should be 2 floating
1589          point numbers that compose it */
1590       (*pos) += 2;
1591       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1592       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1593
1594       return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
1595
1596     case STRUCTOP_STRUCT:
1597       tem = longest_to_int (exp->elts[pc + 1].longconst);
1598       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1599       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1600       if (noside == EVAL_SKIP)
1601         goto nosideret;
1602       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1603         return value_zero (lookup_struct_elt_type (value_type (arg1),
1604                                                    &exp->elts[pc + 2].string,
1605                                                    0),
1606                            lval_memory);
1607       else
1608         {
1609           struct value *temp = arg1;
1610           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1611                                    NULL, "structure");
1612         }
1613
1614     case STRUCTOP_PTR:
1615       tem = longest_to_int (exp->elts[pc + 1].longconst);
1616       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1617       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1618       if (noside == EVAL_SKIP)
1619         goto nosideret;
1620
1621       /* JYG: if print object is on we need to replace the base type
1622          with rtti type in order to continue on with successful
1623          lookup of member / method only available in the rtti type. */
1624       {
1625         struct type *type = value_type (arg1);
1626         struct type *real_type;
1627         int full, top, using_enc;
1628
1629         if (objectprint && TYPE_TARGET_TYPE(type) &&
1630             (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1631           {
1632             real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
1633             if (real_type)
1634               {
1635                 if (TYPE_CODE (type) == TYPE_CODE_PTR)
1636                   real_type = lookup_pointer_type (real_type);
1637                 else
1638                   real_type = lookup_reference_type (real_type);
1639
1640                 arg1 = value_cast (real_type, arg1);
1641               }
1642           }
1643       }
1644
1645       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1646         return value_zero (lookup_struct_elt_type (value_type (arg1),
1647                                                    &exp->elts[pc + 2].string,
1648                                                    0),
1649                            lval_memory);
1650       else
1651         {
1652           struct value *temp = arg1;
1653           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1654                                    NULL, "structure pointer");
1655         }
1656
1657     case STRUCTOP_MEMBER:
1658     case STRUCTOP_MPTR:
1659       if (op == STRUCTOP_MEMBER)
1660         arg1 = evaluate_subexp_for_address (exp, pos, noside);
1661       else
1662         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1663
1664       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1665
1666       if (noside == EVAL_SKIP)
1667         goto nosideret;
1668
1669       type = check_typedef (value_type (arg2));
1670       switch (TYPE_CODE (type))
1671         {
1672         case TYPE_CODE_METHODPTR:
1673           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1674             return value_zero (TYPE_TARGET_TYPE (type), not_lval);
1675           else
1676             {
1677               arg2 = cplus_method_ptr_to_value (&arg1, arg2);
1678               gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
1679               return value_ind (arg2);
1680             }
1681
1682         case TYPE_CODE_MEMBERPTR:
1683           /* Now, convert these values to an address.  */
1684           arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1685                              arg1);
1686
1687           mem_offset = value_as_long (arg2);
1688
1689           arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1690                                      value_as_long (arg1) + mem_offset);
1691           return value_ind (arg3);
1692
1693         default:
1694           error (_("non-pointer-to-member value used in pointer-to-member construct"));
1695         }
1696
1697     case BINOP_CONCAT:
1698       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1699       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1700       if (noside == EVAL_SKIP)
1701         goto nosideret;
1702       if (binop_user_defined_p (op, arg1, arg2))
1703         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1704       else
1705         return value_concat (arg1, arg2);
1706
1707     case BINOP_ASSIGN:
1708       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1709       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1710
1711       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1712         return arg1;
1713       if (binop_user_defined_p (op, arg1, arg2))
1714         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1715       else
1716         return value_assign (arg1, arg2);
1717
1718     case BINOP_ASSIGN_MODIFY:
1719       (*pos) += 2;
1720       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1721       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1722       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1723         return arg1;
1724       op = exp->elts[pc + 1].opcode;
1725       if (binop_user_defined_p (op, arg1, arg2))
1726         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1727       else if (op == BINOP_ADD && ptrmath_type_p (value_type (arg1)))
1728         arg2 = value_ptradd (arg1, arg2);
1729       else if (op == BINOP_SUB && ptrmath_type_p (value_type (arg1)))
1730         arg2 = value_ptrsub (arg1, arg2);
1731       else
1732         {
1733           struct value *tmp = arg1;
1734
1735           /* For shift and integer exponentiation operations,
1736              only promote the first argument.  */
1737           if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
1738               && is_integral_type (value_type (arg2)))
1739             unop_promote (exp->language_defn, exp->gdbarch, &tmp);
1740           else
1741             binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
1742
1743           arg2 = value_binop (tmp, arg2, op);
1744         }
1745       return value_assign (arg1, arg2);
1746
1747     case BINOP_ADD:
1748       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1749       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1750       if (noside == EVAL_SKIP)
1751         goto nosideret;
1752       if (binop_user_defined_p (op, arg1, arg2))
1753         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1754       else if (ptrmath_type_p (value_type (arg1)))
1755         return value_ptradd (arg1, arg2);
1756       else if (ptrmath_type_p (value_type (arg2)))
1757         return value_ptradd (arg2, arg1);
1758       else
1759         {
1760           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
1761           return value_binop (arg1, arg2, BINOP_ADD);
1762         }
1763
1764     case BINOP_SUB:
1765       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1766       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1767       if (noside == EVAL_SKIP)
1768         goto nosideret;
1769       if (binop_user_defined_p (op, arg1, arg2))
1770         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1771       else if (ptrmath_type_p (value_type (arg1)))
1772         {
1773           if (ptrmath_type_p (value_type (arg2)))
1774             {
1775               /* FIXME -- should be ptrdiff_t */
1776               type = builtin_type (exp->gdbarch)->builtin_long;
1777               return value_from_longest (type, value_ptrdiff (arg1, arg2));
1778             }
1779           else
1780             return value_ptrsub (arg1, arg2);
1781         }
1782       else
1783         {
1784           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
1785           return value_binop (arg1, arg2, BINOP_SUB);
1786         }
1787
1788     case BINOP_EXP:
1789     case BINOP_MUL:
1790     case BINOP_DIV:
1791     case BINOP_INTDIV:
1792     case BINOP_REM:
1793     case BINOP_MOD:
1794     case BINOP_LSH:
1795     case BINOP_RSH:
1796     case BINOP_BITWISE_AND:
1797     case BINOP_BITWISE_IOR:
1798     case BINOP_BITWISE_XOR:
1799       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1800       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1801       if (noside == EVAL_SKIP)
1802         goto nosideret;
1803       if (binop_user_defined_p (op, arg1, arg2))
1804         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1805       else
1806         {
1807           /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
1808              fudge arg2 to avoid division-by-zero, the caller is
1809              (theoretically) only looking for the type of the result.  */
1810           if (noside == EVAL_AVOID_SIDE_EFFECTS
1811               /* ??? Do we really want to test for BINOP_MOD here?
1812                  The implementation of value_binop gives it a well-defined
1813                  value.  */
1814               && (op == BINOP_DIV
1815                   || op == BINOP_INTDIV
1816                   || op == BINOP_REM
1817                   || op == BINOP_MOD)
1818               && value_logical_not (arg2))
1819             {
1820               struct value *v_one, *retval;
1821
1822               v_one = value_one (value_type (arg2), not_lval);
1823               binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
1824               retval = value_binop (arg1, v_one, op);
1825               return retval;
1826             }
1827           else
1828             {
1829               /* For shift and integer exponentiation operations,
1830                  only promote the first argument.  */
1831               if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
1832                   && is_integral_type (value_type (arg2)))
1833                 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
1834               else
1835                 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
1836
1837               return value_binop (arg1, arg2, op);
1838             }
1839         }
1840
1841     case BINOP_RANGE:
1842       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1843       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1844       if (noside == EVAL_SKIP)
1845         goto nosideret;
1846       error (_("':' operator used in invalid context"));
1847
1848     case BINOP_SUBSCRIPT:
1849       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1850       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1851       if (noside == EVAL_SKIP)
1852         goto nosideret;
1853       if (binop_user_defined_p (op, arg1, arg2))
1854         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1855       else
1856         {
1857           /* If the user attempts to subscript something that is not an
1858              array or pointer type (like a plain int variable for example),
1859              then report this as an error. */
1860
1861           arg1 = coerce_ref (arg1);
1862           type = check_typedef (value_type (arg1));
1863           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1864               && TYPE_CODE (type) != TYPE_CODE_PTR)
1865             {
1866               if (TYPE_NAME (type))
1867                 error (_("cannot subscript something of type `%s'"),
1868                        TYPE_NAME (type));
1869               else
1870                 error (_("cannot subscript requested type"));
1871             }
1872
1873           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1874             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1875           else
1876             return value_subscript (arg1, arg2);
1877         }
1878
1879     case BINOP_IN:
1880       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1881       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1882       if (noside == EVAL_SKIP)
1883         goto nosideret;
1884       type = language_bool_type (exp->language_defn, exp->gdbarch);
1885       return value_from_longest (type, (LONGEST) value_in (arg1, arg2));
1886
1887     case MULTI_SUBSCRIPT:
1888       (*pos) += 2;
1889       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1890       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1891       while (nargs-- > 0)
1892         {
1893           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1894           /* FIXME:  EVAL_SKIP handling may not be correct. */
1895           if (noside == EVAL_SKIP)
1896             {
1897               if (nargs > 0)
1898                 {
1899                   continue;
1900                 }
1901               else
1902                 {
1903                   goto nosideret;
1904                 }
1905             }
1906           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1907           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1908             {
1909               /* If the user attempts to subscript something that has no target
1910                  type (like a plain int variable for example), then report this
1911                  as an error. */
1912
1913               type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
1914               if (type != NULL)
1915                 {
1916                   arg1 = value_zero (type, VALUE_LVAL (arg1));
1917                   noside = EVAL_SKIP;
1918                   continue;
1919                 }
1920               else
1921                 {
1922                   error (_("cannot subscript something of type `%s'"),
1923                          TYPE_NAME (value_type (arg1)));
1924                 }
1925             }
1926
1927           if (binop_user_defined_p (op, arg1, arg2))
1928             {
1929               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1930             }
1931           else
1932             {
1933               arg1 = coerce_ref (arg1);
1934               type = check_typedef (value_type (arg1));
1935
1936               switch (TYPE_CODE (type))
1937                 {
1938                 case TYPE_CODE_PTR:
1939                 case TYPE_CODE_ARRAY:
1940                 case TYPE_CODE_STRING:
1941                   arg1 = value_subscript (arg1, arg2);
1942                   break;
1943
1944                 case TYPE_CODE_BITSTRING:
1945                   type = language_bool_type (exp->language_defn, exp->gdbarch);
1946                   arg1 = value_bitstring_subscript (type, arg1, arg2);
1947                   break;
1948
1949                 default:
1950                   if (TYPE_NAME (type))
1951                     error (_("cannot subscript something of type `%s'"),
1952                            TYPE_NAME (type));
1953                   else
1954                     error (_("cannot subscript requested type"));
1955                 }
1956             }
1957         }
1958       return (arg1);
1959
1960     multi_f77_subscript:
1961       {
1962         int subscript_array[MAX_FORTRAN_DIMS];
1963         int array_size_array[MAX_FORTRAN_DIMS];
1964         int ndimensions = 1, i;
1965         struct type *tmp_type;
1966         int offset_item;        /* The array offset where the item lives */
1967
1968         if (nargs > MAX_FORTRAN_DIMS)
1969           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
1970
1971         tmp_type = check_typedef (value_type (arg1));
1972         ndimensions = calc_f77_array_dims (type);
1973
1974         if (nargs != ndimensions)
1975           error (_("Wrong number of subscripts"));
1976
1977         /* Now that we know we have a legal array subscript expression
1978            let us actually find out where this element exists in the array. */
1979
1980         offset_item = 0;
1981         /* Take array indices left to right */
1982         for (i = 0; i < nargs; i++)
1983           {
1984             /* Evaluate each subscript, It must be a legal integer in F77 */
1985             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1986
1987             /* Fill in the subscript and array size arrays */
1988
1989             subscript_array[i] = value_as_long (arg2);
1990           }
1991
1992         /* Internal type of array is arranged right to left */
1993         for (i = 0; i < nargs; i++)
1994           {
1995             retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1996             if (retcode == BOUND_FETCH_ERROR)
1997               error (_("Cannot obtain dynamic upper bound"));
1998
1999             retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
2000             if (retcode == BOUND_FETCH_ERROR)
2001               error (_("Cannot obtain dynamic lower bound"));
2002
2003             array_size_array[nargs - i - 1] = upper - lower + 1;
2004
2005             /* Zero-normalize subscripts so that offsetting will work. */
2006
2007             subscript_array[nargs - i - 1] -= lower;
2008
2009             /* If we are at the bottom of a multidimensional
2010                array type then keep a ptr to the last ARRAY
2011                type around for use when calling value_subscript()
2012                below. This is done because we pretend to value_subscript
2013                that we actually have a one-dimensional array
2014                of base element type that we apply a simple
2015                offset to. */
2016
2017             if (i < nargs - 1)
2018               tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
2019           }
2020
2021         /* Now let us calculate the offset for this item */
2022
2023         offset_item = subscript_array[ndimensions - 1];
2024
2025         for (i = ndimensions - 1; i > 0; --i)
2026           offset_item =
2027             array_size_array[i - 1] * offset_item + subscript_array[i - 1];
2028
2029         /* Construct a value node with the value of the offset */
2030
2031         arg2 = value_from_longest (builtin_type_f_integer, offset_item);
2032
2033         /* Let us now play a dirty trick: we will take arg1
2034            which is a value node pointing to the topmost level
2035            of the multidimensional array-set and pretend
2036            that it is actually a array of the final element
2037            type, this will ensure that value_subscript()
2038            returns the correct type value */
2039
2040         deprecated_set_value_type (arg1, tmp_type);
2041         return value_subscripted_rvalue (arg1, arg2, 0);
2042       }
2043
2044     case BINOP_LOGICAL_AND:
2045       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2046       if (noside == EVAL_SKIP)
2047         {
2048           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2049           goto nosideret;
2050         }
2051
2052       oldpos = *pos;
2053       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2054       *pos = oldpos;
2055
2056       if (binop_user_defined_p (op, arg1, arg2))
2057         {
2058           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2059           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2060         }
2061       else
2062         {
2063           tem = value_logical_not (arg1);
2064           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2065                                   (tem ? EVAL_SKIP : noside));
2066           type = language_bool_type (exp->language_defn, exp->gdbarch);
2067           return value_from_longest (type,
2068                              (LONGEST) (!tem && !value_logical_not (arg2)));
2069         }
2070
2071     case BINOP_LOGICAL_OR:
2072       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2073       if (noside == EVAL_SKIP)
2074         {
2075           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2076           goto nosideret;
2077         }
2078
2079       oldpos = *pos;
2080       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2081       *pos = oldpos;
2082
2083       if (binop_user_defined_p (op, arg1, arg2))
2084         {
2085           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2086           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2087         }
2088       else
2089         {
2090           tem = value_logical_not (arg1);
2091           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2092                                   (!tem ? EVAL_SKIP : noside));
2093           type = language_bool_type (exp->language_defn, exp->gdbarch);
2094           return value_from_longest (type,
2095                              (LONGEST) (!tem || !value_logical_not (arg2)));
2096         }
2097
2098     case BINOP_EQUAL:
2099       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2100       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2101       if (noside == EVAL_SKIP)
2102         goto nosideret;
2103       if (binop_user_defined_p (op, arg1, arg2))
2104         {
2105           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2106         }
2107       else
2108         {
2109           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2110           tem = value_equal (arg1, arg2);
2111           type = language_bool_type (exp->language_defn, exp->gdbarch);
2112           return value_from_longest (type, (LONGEST) tem);
2113         }
2114
2115     case BINOP_NOTEQUAL:
2116       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2117       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2118       if (noside == EVAL_SKIP)
2119         goto nosideret;
2120       if (binop_user_defined_p (op, arg1, arg2))
2121         {
2122           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2123         }
2124       else
2125         {
2126           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2127           tem = value_equal (arg1, arg2);
2128           type = language_bool_type (exp->language_defn, exp->gdbarch);
2129           return value_from_longest (type, (LONGEST) ! tem);
2130         }
2131
2132     case BINOP_LESS:
2133       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2134       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2135       if (noside == EVAL_SKIP)
2136         goto nosideret;
2137       if (binop_user_defined_p (op, arg1, arg2))
2138         {
2139           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2140         }
2141       else
2142         {
2143           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2144           tem = value_less (arg1, arg2);
2145           type = language_bool_type (exp->language_defn, exp->gdbarch);
2146           return value_from_longest (type, (LONGEST) tem);
2147         }
2148
2149     case BINOP_GTR:
2150       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2151       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2152       if (noside == EVAL_SKIP)
2153         goto nosideret;
2154       if (binop_user_defined_p (op, arg1, arg2))
2155         {
2156           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2157         }
2158       else
2159         {
2160           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2161           tem = value_less (arg2, arg1);
2162           type = language_bool_type (exp->language_defn, exp->gdbarch);
2163           return value_from_longest (type, (LONGEST) tem);
2164         }
2165
2166     case BINOP_GEQ:
2167       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2168       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2169       if (noside == EVAL_SKIP)
2170         goto nosideret;
2171       if (binop_user_defined_p (op, arg1, arg2))
2172         {
2173           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2174         }
2175       else
2176         {
2177           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2178           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2179           type = language_bool_type (exp->language_defn, exp->gdbarch);
2180           return value_from_longest (type, (LONGEST) tem);
2181         }
2182
2183     case BINOP_LEQ:
2184       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2185       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2186       if (noside == EVAL_SKIP)
2187         goto nosideret;
2188       if (binop_user_defined_p (op, arg1, arg2))
2189         {
2190           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2191         }
2192       else
2193         {
2194           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2195           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2196           type = language_bool_type (exp->language_defn, exp->gdbarch);
2197           return value_from_longest (type, (LONGEST) tem);
2198         }
2199
2200     case BINOP_REPEAT:
2201       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2202       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2203       if (noside == EVAL_SKIP)
2204         goto nosideret;
2205       type = check_typedef (value_type (arg2));
2206       if (TYPE_CODE (type) != TYPE_CODE_INT)
2207         error (_("Non-integral right operand for \"@\" operator."));
2208       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2209         {
2210           return allocate_repeat_value (value_type (arg1),
2211                                      longest_to_int (value_as_long (arg2)));
2212         }
2213       else
2214         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2215
2216     case BINOP_COMMA:
2217       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2218       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2219
2220     case UNOP_PLUS:
2221       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2222       if (noside == EVAL_SKIP)
2223         goto nosideret;
2224       if (unop_user_defined_p (op, arg1))
2225         return value_x_unop (arg1, op, noside);
2226       else
2227         {
2228           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2229           return value_pos (arg1);
2230         }
2231
2232     case UNOP_NEG:
2233       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2234       if (noside == EVAL_SKIP)
2235         goto nosideret;
2236       if (unop_user_defined_p (op, arg1))
2237         return value_x_unop (arg1, op, noside);
2238       else
2239         {
2240           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2241           return value_neg (arg1);
2242         }
2243
2244     case UNOP_COMPLEMENT:
2245       /* C++: check for and handle destructor names.  */
2246       op = exp->elts[*pos].opcode;
2247
2248       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2249       if (noside == EVAL_SKIP)
2250         goto nosideret;
2251       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2252         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2253       else
2254         {
2255           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2256           return value_complement (arg1);
2257         }
2258
2259     case UNOP_LOGICAL_NOT:
2260       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2261       if (noside == EVAL_SKIP)
2262         goto nosideret;
2263       if (unop_user_defined_p (op, arg1))
2264         return value_x_unop (arg1, op, noside);
2265       else
2266         {
2267           type = language_bool_type (exp->language_defn, exp->gdbarch);
2268           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2269         }
2270
2271     case UNOP_IND:
2272       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2273         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2274       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2275       type = check_typedef (value_type (arg1));
2276       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2277           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2278         error (_("Attempt to dereference pointer to member without an object"));
2279       if (noside == EVAL_SKIP)
2280         goto nosideret;
2281       if (unop_user_defined_p (op, arg1))
2282         return value_x_unop (arg1, op, noside);
2283       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2284         {
2285           type = check_typedef (value_type (arg1));
2286           if (TYPE_CODE (type) == TYPE_CODE_PTR
2287               || TYPE_CODE (type) == TYPE_CODE_REF
2288           /* In C you can dereference an array to get the 1st elt.  */
2289               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2290             )
2291             return value_zero (TYPE_TARGET_TYPE (type),
2292                                lval_memory);
2293           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2294             /* GDB allows dereferencing an int.  */
2295             return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2296                                lval_memory);
2297           else
2298             error (_("Attempt to take contents of a non-pointer value."));
2299         }
2300
2301       /* Allow * on an integer so we can cast it to whatever we want.
2302          This returns an int, which seems like the most C-like thing to
2303          do.  "long long" variables are rare enough that
2304          BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
2305       if (TYPE_CODE (type) == TYPE_CODE_INT)
2306         return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2307                               (CORE_ADDR) value_as_address (arg1));
2308       return value_ind (arg1);
2309
2310     case UNOP_ADDR:
2311       /* C++: check for and handle pointer to members.  */
2312
2313       op = exp->elts[*pos].opcode;
2314
2315       if (noside == EVAL_SKIP)
2316         {
2317           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2318           goto nosideret;
2319         }
2320       else
2321         {
2322           struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
2323           return retvalp;
2324         }
2325
2326     case UNOP_SIZEOF:
2327       if (noside == EVAL_SKIP)
2328         {
2329           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2330           goto nosideret;
2331         }
2332       return evaluate_subexp_for_sizeof (exp, pos);
2333
2334     case UNOP_CAST:
2335       (*pos) += 2;
2336       type = exp->elts[pc + 1].type;
2337       arg1 = evaluate_subexp (type, exp, pos, noside);
2338       if (noside == EVAL_SKIP)
2339         goto nosideret;
2340       if (type != value_type (arg1))
2341         arg1 = value_cast (type, arg1);
2342       return arg1;
2343
2344     case UNOP_MEMVAL:
2345       (*pos) += 2;
2346       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2347       if (noside == EVAL_SKIP)
2348         goto nosideret;
2349       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2350         return value_zero (exp->elts[pc + 1].type, lval_memory);
2351       else
2352         return value_at_lazy (exp->elts[pc + 1].type,
2353                               value_as_address (arg1));
2354
2355     case UNOP_MEMVAL_TLS:
2356       (*pos) += 3;
2357       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2358       if (noside == EVAL_SKIP)
2359         goto nosideret;
2360       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2361         return value_zero (exp->elts[pc + 2].type, lval_memory);
2362       else
2363         {
2364           CORE_ADDR tls_addr;
2365           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2366                                                    value_as_address (arg1));
2367           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2368         }
2369
2370     case UNOP_PREINCREMENT:
2371       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2372       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2373         return arg1;
2374       else if (unop_user_defined_p (op, arg1))
2375         {
2376           return value_x_unop (arg1, op, noside);
2377         }
2378       else
2379         {
2380           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2381           if (ptrmath_type_p (value_type (arg1)))
2382             arg2 = value_ptradd (arg1, arg2);
2383           else
2384             {
2385               struct value *tmp = arg1;
2386               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2387               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2388             }
2389
2390           return value_assign (arg1, arg2);
2391         }
2392
2393     case UNOP_PREDECREMENT:
2394       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2395       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2396         return arg1;
2397       else if (unop_user_defined_p (op, arg1))
2398         {
2399           return value_x_unop (arg1, op, noside);
2400         }
2401       else
2402         {
2403           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2404           if (ptrmath_type_p (value_type (arg1)))
2405             arg2 = value_ptrsub (arg1, arg2);
2406           else
2407             {
2408               struct value *tmp = arg1;
2409               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2410               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2411             }
2412
2413           return value_assign (arg1, arg2);
2414         }
2415
2416     case UNOP_POSTINCREMENT:
2417       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2418       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2419         return arg1;
2420       else if (unop_user_defined_p (op, arg1))
2421         {
2422           return value_x_unop (arg1, op, noside);
2423         }
2424       else
2425         {
2426           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2427           if (ptrmath_type_p (value_type (arg1)))
2428             arg2 = value_ptradd (arg1, arg2);
2429           else
2430             {
2431               struct value *tmp = arg1;
2432               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2433               arg2 = value_binop (tmp, arg2, BINOP_ADD);
2434             }
2435
2436           value_assign (arg1, arg2);
2437           return arg1;
2438         }
2439
2440     case UNOP_POSTDECREMENT:
2441       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2442       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2443         return arg1;
2444       else if (unop_user_defined_p (op, arg1))
2445         {
2446           return value_x_unop (arg1, op, noside);
2447         }
2448       else
2449         {
2450           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2451           if (ptrmath_type_p (value_type (arg1)))
2452             arg2 = value_ptrsub (arg1, arg2);
2453           else
2454             {
2455               struct value *tmp = arg1;
2456               binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2457               arg2 = value_binop (tmp, arg2, BINOP_SUB);
2458             }
2459
2460           value_assign (arg1, arg2);
2461           return arg1;
2462         }
2463
2464     case OP_THIS:
2465       (*pos) += 1;
2466       return value_of_this (1);
2467
2468     case OP_OBJC_SELF:
2469       (*pos) += 1;
2470       return value_of_local ("self", 1);
2471
2472     case OP_TYPE:
2473       /* The value is not supposed to be used.  This is here to make it
2474          easier to accommodate expressions that contain types.  */
2475       (*pos) += 2;
2476       if (noside == EVAL_SKIP)
2477         goto nosideret;
2478       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2479         return allocate_value (exp->elts[pc + 1].type);
2480       else
2481         error (_("Attempt to use a type name as an expression"));
2482
2483     default:
2484       /* Removing this case and compiling with gcc -Wall reveals that
2485          a lot of cases are hitting this case.  Some of these should
2486          probably be removed from expression.h; others are legitimate
2487          expressions which are (apparently) not fully implemented.
2488
2489          If there are any cases landing here which mean a user error,
2490          then they should be separate cases, with more descriptive
2491          error messages.  */
2492
2493       error (_("\
2494 GDB does not (yet) know how to evaluate that kind of expression"));
2495     }
2496
2497 nosideret:
2498   return value_from_longest (builtin_type_int8, (LONGEST) 1);
2499 }
2500 \f
2501 /* Evaluate a subexpression of EXP, at index *POS,
2502    and return the address of that subexpression.
2503    Advance *POS over the subexpression.
2504    If the subexpression isn't an lvalue, get an error.
2505    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2506    then only the type of the result need be correct.  */
2507
2508 static struct value *
2509 evaluate_subexp_for_address (struct expression *exp, int *pos,
2510                              enum noside noside)
2511 {
2512   enum exp_opcode op;
2513   int pc;
2514   struct symbol *var;
2515   struct value *x;
2516   int tem;
2517
2518   pc = (*pos);
2519   op = exp->elts[pc].opcode;
2520
2521   switch (op)
2522     {
2523     case UNOP_IND:
2524       (*pos)++;
2525       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2526
2527       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2528       if (unop_user_defined_p (op, x))
2529         {
2530           x = value_x_unop (x, op, noside);
2531           goto default_case_after_eval;
2532         }
2533
2534       return x;
2535
2536     case UNOP_MEMVAL:
2537       (*pos) += 3;
2538       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2539                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2540
2541     case OP_VAR_VALUE:
2542       var = exp->elts[pc + 2].symbol;
2543
2544       /* C++: The "address" of a reference should yield the address
2545        * of the object pointed to. Let value_addr() deal with it. */
2546       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2547         goto default_case;
2548
2549       (*pos) += 4;
2550       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2551         {
2552           struct type *type =
2553           lookup_pointer_type (SYMBOL_TYPE (var));
2554           enum address_class sym_class = SYMBOL_CLASS (var);
2555
2556           if (sym_class == LOC_CONST
2557               || sym_class == LOC_CONST_BYTES
2558               || sym_class == LOC_REGISTER)
2559             error (_("Attempt to take address of register or constant."));
2560
2561           return
2562             value_zero (type, not_lval);
2563         }
2564       else if (symbol_read_needs_frame (var))
2565         return
2566           locate_var_value
2567           (var,
2568            block_innermost_frame (exp->elts[pc + 1].block));
2569       else
2570         return locate_var_value (var, NULL);
2571
2572     case OP_SCOPE:
2573       tem = longest_to_int (exp->elts[pc + 2].longconst);
2574       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2575       x = value_aggregate_elt (exp->elts[pc + 1].type,
2576                                &exp->elts[pc + 3].string,
2577                                1, noside);
2578       if (x == NULL)
2579         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2580       return x;
2581
2582     default:
2583     default_case:
2584       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2585     default_case_after_eval:
2586       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2587         {
2588           struct type *type = check_typedef (value_type (x));
2589
2590           if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2591             return value_zero (lookup_pointer_type (value_type (x)),
2592                                not_lval);
2593           else if (TYPE_CODE (type) == TYPE_CODE_REF)
2594             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2595                                not_lval);
2596           else
2597             error (_("Attempt to take address of value not located in memory."));
2598         }
2599       return value_addr (x);
2600     }
2601 }
2602
2603 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2604    When used in contexts where arrays will be coerced anyway, this is
2605    equivalent to `evaluate_subexp' but much faster because it avoids
2606    actually fetching array contents (perhaps obsolete now that we have
2607    value_lazy()).
2608
2609    Note that we currently only do the coercion for C expressions, where
2610    arrays are zero based and the coercion is correct.  For other languages,
2611    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2612    to decide if coercion is appropriate.
2613
2614  */
2615
2616 struct value *
2617 evaluate_subexp_with_coercion (struct expression *exp,
2618                                int *pos, enum noside noside)
2619 {
2620   enum exp_opcode op;
2621   int pc;
2622   struct value *val;
2623   struct symbol *var;
2624
2625   pc = (*pos);
2626   op = exp->elts[pc].opcode;
2627
2628   switch (op)
2629     {
2630     case OP_VAR_VALUE:
2631       var = exp->elts[pc + 2].symbol;
2632       if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
2633           && CAST_IS_CONVERSION)
2634         {
2635           (*pos) += 4;
2636           val =
2637             locate_var_value
2638             (var, block_innermost_frame (exp->elts[pc + 1].block));
2639           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
2640                              val);
2641         }
2642       /* FALLTHROUGH */
2643
2644     default:
2645       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2646     }
2647 }
2648
2649 /* Evaluate a subexpression of EXP, at index *POS,
2650    and return a value for the size of that subexpression.
2651    Advance *POS over the subexpression.  */
2652
2653 static struct value *
2654 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2655 {
2656   /* FIXME: This should be size_t.  */
2657   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
2658   enum exp_opcode op;
2659   int pc;
2660   struct type *type;
2661   struct value *val;
2662
2663   pc = (*pos);
2664   op = exp->elts[pc].opcode;
2665
2666   switch (op)
2667     {
2668       /* This case is handled specially
2669          so that we avoid creating a value for the result type.
2670          If the result type is very big, it's desirable not to
2671          create a value unnecessarily.  */
2672     case UNOP_IND:
2673       (*pos)++;
2674       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2675       type = check_typedef (value_type (val));
2676       if (TYPE_CODE (type) != TYPE_CODE_PTR
2677           && TYPE_CODE (type) != TYPE_CODE_REF
2678           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2679         error (_("Attempt to take contents of a non-pointer value."));
2680       type = check_typedef (TYPE_TARGET_TYPE (type));
2681       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2682
2683     case UNOP_MEMVAL:
2684       (*pos) += 3;
2685       type = check_typedef (exp->elts[pc + 1].type);
2686       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2687
2688     case OP_VAR_VALUE:
2689       (*pos) += 4;
2690       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2691       return
2692         value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2693
2694     default:
2695       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2696       return value_from_longest (size_type,
2697                                  (LONGEST) TYPE_LENGTH (value_type (val)));
2698     }
2699 }
2700
2701 /* Parse a type expression in the string [P..P+LENGTH). */
2702
2703 struct type *
2704 parse_and_eval_type (char *p, int length)
2705 {
2706   char *tmp = (char *) alloca (length + 4);
2707   struct expression *expr;
2708   tmp[0] = '(';
2709   memcpy (tmp + 1, p, length);
2710   tmp[length + 1] = ')';
2711   tmp[length + 2] = '0';
2712   tmp[length + 3] = '\0';
2713   expr = parse_expression (tmp);
2714   if (expr->elts[0].opcode != UNOP_CAST)
2715     error (_("Internal error in eval_type."));
2716   return expr->elts[1].type;
2717 }
2718
2719 int
2720 calc_f77_array_dims (struct type *array_type)
2721 {
2722   int ndimen = 1;
2723   struct type *tmp_type;
2724
2725   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2726     error (_("Can't get dimensions for a non-array type"));
2727
2728   tmp_type = array_type;
2729
2730   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2731     {
2732       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2733         ++ndimen;
2734     }
2735   return ndimen;
2736 }