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
1003         (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1004         if (noside == EVAL_SKIP)
1005           goto nosideret;
1006
1007         if (sel[len] != 0)
1008           sel[len] = 0;         /* Make sure it's terminated.  */
1009         return value_from_longest (lookup_pointer_type (builtin_type_void),
1010                                    lookup_child_selector (sel));
1011       }
1012
1013     case OP_OBJC_MSGCALL:
1014       {                         /* Objective C message (method) call.  */
1015
1016         static CORE_ADDR responds_selector = 0;
1017         static CORE_ADDR method_selector = 0;
1018
1019         CORE_ADDR selector = 0;
1020
1021         int struct_return = 0;
1022         int sub_no_side = 0;
1023
1024         static struct value *msg_send = NULL;
1025         static struct value *msg_send_stret = NULL;
1026         static int gnu_runtime = 0;
1027
1028         struct value *target = NULL;
1029         struct value *method = NULL;
1030         struct value *called_method = NULL;
1031
1032         struct type *selector_type = NULL;
1033
1034         struct value *ret = NULL;
1035         CORE_ADDR addr = 0;
1036
1037         selector = exp->elts[pc + 1].longconst;
1038         nargs = exp->elts[pc + 2].longconst;
1039         argvec = (struct value **) alloca (sizeof (struct value *)
1040                                            * (nargs + 5));
1041
1042         (*pos) += 3;
1043
1044         selector_type = lookup_pointer_type (builtin_type_void);
1045         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1046           sub_no_side = EVAL_NORMAL;
1047         else
1048           sub_no_side = noside;
1049
1050         target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1051
1052         if (value_as_long (target) == 0)
1053           return value_from_longest (builtin_type_long, 0);
1054
1055         if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0))
1056           gnu_runtime = 1;
1057
1058         /* Find the method dispatch (Apple runtime) or method lookup
1059            (GNU runtime) function for Objective-C.  These will be used
1060            to lookup the symbol information for the method.  If we
1061            can't find any symbol information, then we'll use these to
1062            call the method, otherwise we can call the method
1063            directly. The msg_send_stret function is used in the special
1064            case of a method that returns a structure (Apple runtime
1065            only).  */
1066         if (gnu_runtime)
1067           {
1068             struct type *type;
1069             type = lookup_pointer_type (builtin_type_void);
1070             type = lookup_function_type (type);
1071             type = lookup_pointer_type (type);
1072             type = lookup_function_type (type);
1073             type = lookup_pointer_type (type);
1074
1075             msg_send = find_function_in_inferior ("objc_msg_lookup");
1076             msg_send_stret = find_function_in_inferior ("objc_msg_lookup");
1077
1078             msg_send = value_from_pointer (type, value_as_address (msg_send));
1079             msg_send_stret = value_from_pointer (type,
1080                                         value_as_address (msg_send_stret));
1081           }
1082         else
1083           {
1084             msg_send = find_function_in_inferior ("objc_msgSend");
1085             /* Special dispatcher for methods returning structs */
1086             msg_send_stret = find_function_in_inferior ("objc_msgSend_stret");
1087           }
1088
1089         /* Verify the target object responds to this method. The
1090            standard top-level 'Object' class uses a different name for
1091            the verification method than the non-standard, but more
1092            often used, 'NSObject' class. Make sure we check for both. */
1093
1094         responds_selector = lookup_child_selector ("respondsToSelector:");
1095         if (responds_selector == 0)
1096           responds_selector = lookup_child_selector ("respondsTo:");
1097
1098         if (responds_selector == 0)
1099           error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
1100
1101         method_selector = lookup_child_selector ("methodForSelector:");
1102         if (method_selector == 0)
1103           method_selector = lookup_child_selector ("methodFor:");
1104
1105         if (method_selector == 0)
1106           error (_("no 'methodFor:' or 'methodForSelector:' method"));
1107
1108         /* Call the verification method, to make sure that the target
1109          class implements the desired method. */
1110
1111         argvec[0] = msg_send;
1112         argvec[1] = target;
1113         argvec[2] = value_from_longest (builtin_type_long, responds_selector);
1114         argvec[3] = value_from_longest (builtin_type_long, selector);
1115         argvec[4] = 0;
1116
1117         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1118         if (gnu_runtime)
1119           {
1120             /* Function objc_msg_lookup returns a pointer.  */
1121             argvec[0] = ret;
1122             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1123           }
1124         if (value_as_long (ret) == 0)
1125           error (_("Target does not respond to this message selector."));
1126
1127         /* Call "methodForSelector:" method, to get the address of a
1128            function method that implements this selector for this
1129            class.  If we can find a symbol at that address, then we
1130            know the return type, parameter types etc.  (that's a good
1131            thing). */
1132
1133         argvec[0] = msg_send;
1134         argvec[1] = target;
1135         argvec[2] = value_from_longest (builtin_type_long, method_selector);
1136         argvec[3] = value_from_longest (builtin_type_long, selector);
1137         argvec[4] = 0;
1138
1139         ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1140         if (gnu_runtime)
1141           {
1142             argvec[0] = ret;
1143             ret = call_function_by_hand (argvec[0], 3, argvec + 1);
1144           }
1145
1146         /* ret should now be the selector.  */
1147
1148         addr = value_as_long (ret);
1149         if (addr)
1150           {
1151             struct symbol *sym = NULL;
1152             /* Is it a high_level symbol?  */
1153
1154             sym = find_pc_function (addr);
1155             if (sym != NULL)
1156               method = value_of_variable (sym, 0);
1157           }
1158
1159         /* If we found a method with symbol information, check to see
1160            if it returns a struct.  Otherwise assume it doesn't.  */
1161
1162         if (method)
1163           {
1164             struct block *b;
1165             CORE_ADDR funaddr;
1166             struct type *val_type;
1167
1168             funaddr = find_function_addr (method, &val_type);
1169
1170             b = block_for_pc (funaddr);
1171
1172             CHECK_TYPEDEF (val_type);
1173
1174             if ((val_type == NULL)
1175                 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
1176               {
1177                 if (expect_type != NULL)
1178                   val_type = expect_type;
1179               }
1180
1181             struct_return = using_struct_return (value_type (method), val_type);
1182           }
1183         else if (expect_type != NULL)
1184           {
1185             struct_return = using_struct_return (NULL,
1186                                                  check_typedef (expect_type));
1187           }
1188
1189         /* Found a function symbol.  Now we will substitute its
1190            value in place of the message dispatcher (obj_msgSend),
1191            so that we call the method directly instead of thru
1192            the dispatcher.  The main reason for doing this is that
1193            we can now evaluate the return value and parameter values
1194            according to their known data types, in case we need to
1195            do things like promotion, dereferencing, special handling
1196            of structs and doubles, etc.
1197
1198            We want to use the type signature of 'method', but still
1199            jump to objc_msgSend() or objc_msgSend_stret() to better
1200            mimic the behavior of the runtime.  */
1201
1202         if (method)
1203           {
1204             if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
1205               error (_("method address has symbol information with non-function type; skipping"));
1206             if (struct_return)
1207               VALUE_ADDRESS (method) = value_as_address (msg_send_stret);
1208             else
1209               VALUE_ADDRESS (method) = value_as_address (msg_send);
1210             called_method = method;
1211           }
1212         else
1213           {
1214             if (struct_return)
1215               called_method = msg_send_stret;
1216             else
1217               called_method = msg_send;
1218           }
1219
1220         if (noside == EVAL_SKIP)
1221           goto nosideret;
1222
1223         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1224           {
1225             /* If the return type doesn't look like a function type,
1226                call an error.  This can happen if somebody tries to
1227                turn a variable into a function call. This is here
1228                because people often want to call, eg, strcmp, which
1229                gdb doesn't know is a function.  If gdb isn't asked for
1230                it's opinion (ie. through "whatis"), it won't offer
1231                it. */
1232
1233             struct type *type = value_type (called_method);
1234             if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1235               type = TYPE_TARGET_TYPE (type);
1236             type = TYPE_TARGET_TYPE (type);
1237
1238             if (type)
1239             {
1240               if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1241                 return allocate_value (expect_type);
1242               else
1243                 return allocate_value (type);
1244             }
1245             else
1246               error (_("Expression of type other than \"method returning ...\" used as a method"));
1247           }
1248
1249         /* Now depending on whether we found a symbol for the method,
1250            we will either call the runtime dispatcher or the method
1251            directly.  */
1252
1253         argvec[0] = called_method;
1254         argvec[1] = target;
1255         argvec[2] = value_from_longest (builtin_type_long, selector);
1256         /* User-supplied arguments.  */
1257         for (tem = 0; tem < nargs; tem++)
1258           argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1259         argvec[tem + 3] = 0;
1260
1261         if (gnu_runtime && (method != NULL))
1262           {
1263             /* Function objc_msg_lookup returns a pointer.  */
1264             deprecated_set_value_type (argvec[0],
1265                                        lookup_function_type (lookup_pointer_type (value_type (argvec[0]))));
1266             argvec[0] = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1267           }
1268
1269         ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
1270         return ret;
1271       }
1272       break;
1273
1274     case OP_FUNCALL:
1275       (*pos) += 2;
1276       op = exp->elts[*pos].opcode;
1277       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1278       /* Allocate arg vector, including space for the function to be
1279          called in argvec[0] and a terminating NULL */
1280       argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
1281       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1282         {
1283           nargs++;
1284           /* First, evaluate the structure into arg2 */
1285           pc2 = (*pos)++;
1286
1287           if (noside == EVAL_SKIP)
1288             goto nosideret;
1289
1290           if (op == STRUCTOP_MEMBER)
1291             {
1292               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1293             }
1294           else
1295             {
1296               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1297             }
1298
1299           /* If the function is a virtual function, then the
1300              aggregate value (providing the structure) plays
1301              its part by providing the vtable.  Otherwise,
1302              it is just along for the ride: call the function
1303              directly.  */
1304
1305           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1306
1307           if (TYPE_CODE (check_typedef (value_type (arg1)))
1308               != TYPE_CODE_METHODPTR)
1309             error (_("Non-pointer-to-member value used in pointer-to-member "
1310                      "construct"));
1311
1312           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1313             {
1314               struct type *method_type = check_typedef (value_type (arg1));
1315               arg1 = value_zero (method_type, not_lval);
1316             }
1317           else
1318             arg1 = cplus_method_ptr_to_value (&arg2, arg1);
1319
1320           /* Now, say which argument to start evaluating from */
1321           tem = 2;
1322         }
1323       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1324         {
1325           /* Hair for method invocations */
1326           int tem2;
1327
1328           nargs++;
1329           /* First, evaluate the structure into arg2 */
1330           pc2 = (*pos)++;
1331           tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1332           *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1333           if (noside == EVAL_SKIP)
1334             goto nosideret;
1335
1336           if (op == STRUCTOP_STRUCT)
1337             {
1338               /* If v is a variable in a register, and the user types
1339                  v.method (), this will produce an error, because v has
1340                  no address.
1341
1342                  A possible way around this would be to allocate a
1343                  copy of the variable on the stack, copy in the
1344                  contents, call the function, and copy out the
1345                  contents.  I.e. convert this from call by reference
1346                  to call by copy-return (or whatever it's called).
1347                  However, this does not work because it is not the
1348                  same: the method being called could stash a copy of
1349                  the address, and then future uses through that address
1350                  (after the method returns) would be expected to
1351                  use the variable itself, not some copy of it.  */
1352               arg2 = evaluate_subexp_for_address (exp, pos, noside);
1353             }
1354           else
1355             {
1356               arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1357             }
1358           /* Now, say which argument to start evaluating from */
1359           tem = 2;
1360         }
1361       else
1362         {
1363           /* Non-method function call */
1364           save_pos1 = *pos;
1365           argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1366           tem = 1;
1367           type = value_type (argvec[0]);
1368           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1369             type = TYPE_TARGET_TYPE (type);
1370           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1371             {
1372               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1373                 {
1374                   /* pai: FIXME This seems to be coercing arguments before
1375                    * overload resolution has been done! */
1376                   argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type, tem - 1),
1377                                                  exp, pos, noside);
1378                 }
1379             }
1380         }
1381
1382       /* Evaluate arguments */
1383       for (; tem <= nargs; tem++)
1384         {
1385           /* Ensure that array expressions are coerced into pointer objects. */
1386           argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1387         }
1388
1389       /* signal end of arglist */
1390       argvec[tem] = 0;
1391
1392       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1393         {
1394           int static_memfuncp;
1395           char tstr[256];
1396
1397           /* Method invocation : stuff "this" as first parameter */
1398           argvec[1] = arg2;
1399           /* Name of method from expression */
1400           strcpy (tstr, &exp->elts[pc2 + 2].string);
1401
1402           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1403             {
1404               /* Language is C++, do some overload resolution before evaluation */
1405               struct value *valp = NULL;
1406
1407               /* Prepare list of argument types for overload resolution */
1408               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1409               for (ix = 1; ix <= nargs; ix++)
1410                 arg_types[ix - 1] = value_type (argvec[ix]);
1411
1412               (void) find_overload_match (arg_types, nargs, tstr,
1413                                      1 /* method */ , 0 /* strict match */ ,
1414                                           &arg2 /* the object */ , NULL,
1415                                           &valp, NULL, &static_memfuncp);
1416
1417
1418               argvec[1] = arg2; /* the ``this'' pointer */
1419               argvec[0] = valp; /* use the method found after overload resolution */
1420             }
1421           else
1422             /* Non-C++ case -- or no overload resolution */
1423             {
1424               struct value *temp = arg2;
1425               argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1426                                             &static_memfuncp,
1427                                             op == STRUCTOP_STRUCT
1428                                        ? "structure" : "structure pointer");
1429               /* value_struct_elt updates temp with the correct value
1430                  of the ``this'' pointer if necessary, so modify argvec[1] to
1431                  reflect any ``this'' changes.  */
1432               arg2 = value_from_longest (lookup_pointer_type(value_type (temp)),
1433                                          VALUE_ADDRESS (temp) + value_offset (temp)
1434                                          + value_embedded_offset (temp));
1435               argvec[1] = arg2; /* the ``this'' pointer */
1436             }
1437
1438           if (static_memfuncp)
1439             {
1440               argvec[1] = argvec[0];
1441               nargs--;
1442               argvec++;
1443             }
1444         }
1445       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1446         {
1447           argvec[1] = arg2;
1448           argvec[0] = arg1;
1449         }
1450       else if (op == OP_VAR_VALUE)
1451         {
1452           /* Non-member function being called */
1453           /* fn: This can only be done for C++ functions.  A C-style function
1454              in a C++ program, for instance, does not have the fields that
1455              are expected here */
1456
1457           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
1458             {
1459               /* Language is C++, do some overload resolution before evaluation */
1460               struct symbol *symp;
1461
1462               /* Prepare list of argument types for overload resolution */
1463               arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
1464               for (ix = 1; ix <= nargs; ix++)
1465                 arg_types[ix - 1] = value_type (argvec[ix]);
1466
1467               (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
1468                                  0 /* not method */ , 0 /* strict match */ ,
1469                       NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
1470                                           NULL, &symp, NULL);
1471
1472               /* Now fix the expression being evaluated */
1473               exp->elts[save_pos1+2].symbol = symp;
1474               argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1475             }
1476           else
1477             {
1478               /* Not C++, or no overload resolution allowed */
1479               /* nothing to be done; argvec already correctly set up */
1480             }
1481         }
1482       else
1483         {
1484           /* It is probably a C-style function */
1485           /* nothing to be done; argvec already correctly set up */
1486         }
1487
1488     do_call_it:
1489
1490       if (noside == EVAL_SKIP)
1491         goto nosideret;
1492       if (argvec[0] == NULL)
1493         error (_("Cannot evaluate function -- may be inlined"));
1494       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1495         {
1496           /* If the return type doesn't look like a function type, call an
1497              error.  This can happen if somebody tries to turn a variable into
1498              a function call. This is here because people often want to
1499              call, eg, strcmp, which gdb doesn't know is a function.  If
1500              gdb isn't asked for it's opinion (ie. through "whatis"),
1501              it won't offer it. */
1502
1503           struct type *ftype =
1504           TYPE_TARGET_TYPE (value_type (argvec[0]));
1505
1506           if (ftype)
1507             return allocate_value (TYPE_TARGET_TYPE (value_type (argvec[0])));
1508           else
1509             error (_("Expression of type other than \"Function returning ...\" used as function"));
1510         }
1511       return call_function_by_hand (argvec[0], nargs, argvec + 1);
1512       /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
1513
1514     case OP_F77_UNDETERMINED_ARGLIST:
1515
1516       /* Remember that in F77, functions, substring ops and
1517          array subscript operations cannot be disambiguated
1518          at parse time.  We have made all array subscript operations,
1519          substring operations as well as function calls  come here
1520          and we now have to discover what the heck this thing actually was.
1521          If it is a function, we process just as if we got an OP_FUNCALL. */
1522
1523       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1524       (*pos) += 2;
1525
1526       /* First determine the type code we are dealing with.  */
1527       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1528       type = check_typedef (value_type (arg1));
1529       code = TYPE_CODE (type);
1530
1531       if (code == TYPE_CODE_PTR)
1532         {
1533           /* Fortran always passes variable to subroutines as pointer.
1534              So we need to look into its target type to see if it is
1535              array, string or function.  If it is, we need to switch
1536              to the target value the original one points to.  */
1537           struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1538
1539           if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1540               || TYPE_CODE (target_type) == TYPE_CODE_STRING
1541               || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1542             {
1543               arg1 = value_ind (arg1);
1544               type = check_typedef (value_type (arg1));
1545               code = TYPE_CODE (type);
1546             }
1547         }
1548
1549       switch (code)
1550         {
1551         case TYPE_CODE_ARRAY:
1552           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1553             return value_f90_subarray (arg1, exp, pos, noside);
1554           else
1555             goto multi_f77_subscript;
1556
1557         case TYPE_CODE_STRING:
1558           if (exp->elts[*pos].opcode == OP_F90_RANGE)
1559             return value_f90_subarray (arg1, exp, pos, noside);
1560           else
1561             {
1562               arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1563               return value_subscript (arg1, arg2);
1564             }
1565
1566         case TYPE_CODE_PTR:
1567         case TYPE_CODE_FUNC:
1568           /* It's a function call. */
1569           /* Allocate arg vector, including space for the function to be
1570              called in argvec[0] and a terminating NULL */
1571           argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
1572           argvec[0] = arg1;
1573           tem = 1;
1574           for (; tem <= nargs; tem++)
1575             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1576           argvec[tem] = 0;      /* signal end of arglist */
1577           goto do_call_it;
1578
1579         default:
1580           error (_("Cannot perform substring on this type"));
1581         }
1582
1583     case OP_COMPLEX:
1584       /* We have a complex number, There should be 2 floating
1585          point numbers that compose it */
1586       (*pos) += 2;
1587       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1588       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1589
1590       return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
1591
1592     case STRUCTOP_STRUCT:
1593       tem = longest_to_int (exp->elts[pc + 1].longconst);
1594       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1595       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1596       if (noside == EVAL_SKIP)
1597         goto nosideret;
1598       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1599         return value_zero (lookup_struct_elt_type (value_type (arg1),
1600                                                    &exp->elts[pc + 2].string,
1601                                                    0),
1602                            lval_memory);
1603       else
1604         {
1605           struct value *temp = arg1;
1606           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1607                                    NULL, "structure");
1608         }
1609
1610     case STRUCTOP_PTR:
1611       tem = longest_to_int (exp->elts[pc + 1].longconst);
1612       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1613       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1614       if (noside == EVAL_SKIP)
1615         goto nosideret;
1616
1617       /* JYG: if print object is on we need to replace the base type
1618          with rtti type in order to continue on with successful
1619          lookup of member / method only available in the rtti type. */
1620       {
1621         struct type *type = value_type (arg1);
1622         struct type *real_type;
1623         int full, top, using_enc;
1624
1625         if (objectprint && TYPE_TARGET_TYPE(type) &&
1626             (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1627           {
1628             real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
1629             if (real_type)
1630               {
1631                 if (TYPE_CODE (type) == TYPE_CODE_PTR)
1632                   real_type = lookup_pointer_type (real_type);
1633                 else
1634                   real_type = lookup_reference_type (real_type);
1635
1636                 arg1 = value_cast (real_type, arg1);
1637               }
1638           }
1639       }
1640
1641       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1642         return value_zero (lookup_struct_elt_type (value_type (arg1),
1643                                                    &exp->elts[pc + 2].string,
1644                                                    0),
1645                            lval_memory);
1646       else
1647         {
1648           struct value *temp = arg1;
1649           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1650                                    NULL, "structure pointer");
1651         }
1652
1653     case STRUCTOP_MEMBER:
1654     case STRUCTOP_MPTR:
1655       if (op == STRUCTOP_MEMBER)
1656         arg1 = evaluate_subexp_for_address (exp, pos, noside);
1657       else
1658         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1659
1660       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1661
1662       if (noside == EVAL_SKIP)
1663         goto nosideret;
1664
1665       type = check_typedef (value_type (arg2));
1666       switch (TYPE_CODE (type))
1667         {
1668         case TYPE_CODE_METHODPTR:
1669           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1670             return value_zero (TYPE_TARGET_TYPE (type), not_lval);
1671           else
1672             {
1673               arg2 = cplus_method_ptr_to_value (&arg1, arg2);
1674               gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
1675               return value_ind (arg2);
1676             }
1677
1678         case TYPE_CODE_MEMBERPTR:
1679           /* Now, convert these values to an address.  */
1680           arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1681                              arg1);
1682
1683           mem_offset = value_as_long (arg2);
1684
1685           arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1686                                      value_as_long (arg1) + mem_offset);
1687           return value_ind (arg3);
1688
1689         default:
1690           error (_("non-pointer-to-member value used in pointer-to-member construct"));
1691         }
1692
1693     case BINOP_CONCAT:
1694       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1695       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1696       if (noside == EVAL_SKIP)
1697         goto nosideret;
1698       if (binop_user_defined_p (op, arg1, arg2))
1699         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1700       else
1701         return value_concat (arg1, arg2);
1702
1703     case BINOP_ASSIGN:
1704       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1705       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1706
1707       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1708         return arg1;
1709       if (binop_user_defined_p (op, arg1, arg2))
1710         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1711       else
1712         return value_assign (arg1, arg2);
1713
1714     case BINOP_ASSIGN_MODIFY:
1715       (*pos) += 2;
1716       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1717       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
1718       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1719         return arg1;
1720       op = exp->elts[pc + 1].opcode;
1721       if (binop_user_defined_p (op, arg1, arg2))
1722         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1723       else if (op == BINOP_ADD && ptrmath_type_p (value_type (arg1)))
1724         arg2 = value_ptradd (arg1, arg2);
1725       else if (op == BINOP_SUB && ptrmath_type_p (value_type (arg1)))
1726         arg2 = value_ptrsub (arg1, arg2);
1727       else
1728         arg2 = value_binop (arg1, arg2, op);
1729       return value_assign (arg1, arg2);
1730
1731     case BINOP_ADD:
1732       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1733       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1734       if (noside == EVAL_SKIP)
1735         goto nosideret;
1736       if (binop_user_defined_p (op, arg1, arg2))
1737         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1738       else if (ptrmath_type_p (value_type (arg1)))
1739         return value_ptradd (arg1, arg2);
1740       else if (ptrmath_type_p (value_type (arg2)))
1741         return value_ptradd (arg2, arg1);
1742       else
1743         return value_binop (arg1, arg2, BINOP_ADD);
1744
1745     case BINOP_SUB:
1746       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1747       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1748       if (noside == EVAL_SKIP)
1749         goto nosideret;
1750       if (binop_user_defined_p (op, arg1, arg2))
1751         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1752       else if (ptrmath_type_p (value_type (arg1)))
1753         {
1754           if (ptrmath_type_p (value_type (arg2)))
1755             {
1756               /* FIXME -- should be ptrdiff_t */
1757               type = builtin_type (exp->gdbarch)->builtin_long;
1758               return value_from_longest (type, value_ptrdiff (arg1, arg2));
1759             }
1760           else
1761             return value_ptrsub (arg1, arg2);
1762         }
1763       else
1764         return value_binop (arg1, arg2, BINOP_SUB);
1765
1766     case BINOP_EXP:
1767     case BINOP_MUL:
1768     case BINOP_DIV:
1769     case BINOP_INTDIV:
1770     case BINOP_REM:
1771     case BINOP_MOD:
1772     case BINOP_LSH:
1773     case BINOP_RSH:
1774     case BINOP_BITWISE_AND:
1775     case BINOP_BITWISE_IOR:
1776     case BINOP_BITWISE_XOR:
1777       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1778       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1779       if (noside == EVAL_SKIP)
1780         goto nosideret;
1781       if (binop_user_defined_p (op, arg1, arg2))
1782         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1783       else
1784         {
1785           /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
1786              fudge arg2 to avoid division-by-zero, the caller is
1787              (theoretically) only looking for the type of the result.  */
1788           if (noside == EVAL_AVOID_SIDE_EFFECTS
1789               /* ??? Do we really want to test for BINOP_MOD here?
1790                  The implementation of value_binop gives it a well-defined
1791                  value.  */
1792               && (op == BINOP_DIV
1793                   || op == BINOP_INTDIV
1794                   || op == BINOP_REM
1795                   || op == BINOP_MOD)
1796               && value_logical_not (arg2))
1797             {
1798               struct value *v_one, *retval;
1799
1800               v_one = value_one (value_type (arg2), not_lval);
1801               retval = value_binop (arg1, v_one, op);
1802               return retval;
1803             }
1804           else
1805             return value_binop (arg1, arg2, op);
1806         }
1807
1808     case BINOP_RANGE:
1809       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1810       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1811       if (noside == EVAL_SKIP)
1812         goto nosideret;
1813       error (_("':' operator used in invalid context"));
1814
1815     case BINOP_SUBSCRIPT:
1816       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1817       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1818       if (noside == EVAL_SKIP)
1819         goto nosideret;
1820       if (binop_user_defined_p (op, arg1, arg2))
1821         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1822       else
1823         {
1824           /* If the user attempts to subscript something that is not an
1825              array or pointer type (like a plain int variable for example),
1826              then report this as an error. */
1827
1828           arg1 = coerce_ref (arg1);
1829           type = check_typedef (value_type (arg1));
1830           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1831               && TYPE_CODE (type) != TYPE_CODE_PTR)
1832             {
1833               if (TYPE_NAME (type))
1834                 error (_("cannot subscript something of type `%s'"),
1835                        TYPE_NAME (type));
1836               else
1837                 error (_("cannot subscript requested type"));
1838             }
1839
1840           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1841             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1842           else
1843             return value_subscript (arg1, arg2);
1844         }
1845
1846     case BINOP_IN:
1847       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1848       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1849       if (noside == EVAL_SKIP)
1850         goto nosideret;
1851       type = language_bool_type (exp->language_defn, exp->gdbarch);
1852       return value_from_longest (type, (LONGEST) value_in (arg1, arg2));
1853
1854     case MULTI_SUBSCRIPT:
1855       (*pos) += 2;
1856       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1857       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1858       while (nargs-- > 0)
1859         {
1860           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1861           /* FIXME:  EVAL_SKIP handling may not be correct. */
1862           if (noside == EVAL_SKIP)
1863             {
1864               if (nargs > 0)
1865                 {
1866                   continue;
1867                 }
1868               else
1869                 {
1870                   goto nosideret;
1871                 }
1872             }
1873           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1874           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1875             {
1876               /* If the user attempts to subscript something that has no target
1877                  type (like a plain int variable for example), then report this
1878                  as an error. */
1879
1880               type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
1881               if (type != NULL)
1882                 {
1883                   arg1 = value_zero (type, VALUE_LVAL (arg1));
1884                   noside = EVAL_SKIP;
1885                   continue;
1886                 }
1887               else
1888                 {
1889                   error (_("cannot subscript something of type `%s'"),
1890                          TYPE_NAME (value_type (arg1)));
1891                 }
1892             }
1893
1894           if (binop_user_defined_p (op, arg1, arg2))
1895             {
1896               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1897             }
1898           else
1899             {
1900               arg1 = coerce_ref (arg1);
1901               type = check_typedef (value_type (arg1));
1902
1903               switch (TYPE_CODE (type))
1904                 {
1905                 case TYPE_CODE_PTR:
1906                 case TYPE_CODE_ARRAY:
1907                 case TYPE_CODE_STRING:
1908                   arg1 = value_subscript (arg1, arg2);
1909                   break;
1910
1911                 case TYPE_CODE_BITSTRING:
1912                   type = language_bool_type (exp->language_defn, exp->gdbarch);
1913                   arg1 = value_bitstring_subscript (type, arg1, arg2);
1914                   break;
1915
1916                 default:
1917                   if (TYPE_NAME (type))
1918                     error (_("cannot subscript something of type `%s'"),
1919                            TYPE_NAME (type));
1920                   else
1921                     error (_("cannot subscript requested type"));
1922                 }
1923             }
1924         }
1925       return (arg1);
1926
1927     multi_f77_subscript:
1928       {
1929         int subscript_array[MAX_FORTRAN_DIMS];
1930         int array_size_array[MAX_FORTRAN_DIMS];
1931         int ndimensions = 1, i;
1932         struct type *tmp_type;
1933         int offset_item;        /* The array offset where the item lives */
1934
1935         if (nargs > MAX_FORTRAN_DIMS)
1936           error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
1937
1938         tmp_type = check_typedef (value_type (arg1));
1939         ndimensions = calc_f77_array_dims (type);
1940
1941         if (nargs != ndimensions)
1942           error (_("Wrong number of subscripts"));
1943
1944         /* Now that we know we have a legal array subscript expression
1945            let us actually find out where this element exists in the array. */
1946
1947         offset_item = 0;
1948         /* Take array indices left to right */
1949         for (i = 0; i < nargs; i++)
1950           {
1951             /* Evaluate each subscript, It must be a legal integer in F77 */
1952             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1953
1954             /* Fill in the subscript and array size arrays */
1955
1956             subscript_array[i] = value_as_long (arg2);
1957           }
1958
1959         /* Internal type of array is arranged right to left */
1960         for (i = 0; i < nargs; i++)
1961           {
1962             retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1963             if (retcode == BOUND_FETCH_ERROR)
1964               error (_("Cannot obtain dynamic upper bound"));
1965
1966             retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1967             if (retcode == BOUND_FETCH_ERROR)
1968               error (_("Cannot obtain dynamic lower bound"));
1969
1970             array_size_array[nargs - i - 1] = upper - lower + 1;
1971
1972             /* Zero-normalize subscripts so that offsetting will work. */
1973
1974             subscript_array[nargs - i - 1] -= lower;
1975
1976             /* If we are at the bottom of a multidimensional
1977                array type then keep a ptr to the last ARRAY
1978                type around for use when calling value_subscript()
1979                below. This is done because we pretend to value_subscript
1980                that we actually have a one-dimensional array
1981                of base element type that we apply a simple
1982                offset to. */
1983
1984             if (i < nargs - 1)
1985               tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1986           }
1987
1988         /* Now let us calculate the offset for this item */
1989
1990         offset_item = subscript_array[ndimensions - 1];
1991
1992         for (i = ndimensions - 1; i > 0; --i)
1993           offset_item =
1994             array_size_array[i - 1] * offset_item + subscript_array[i - 1];
1995
1996         /* Construct a value node with the value of the offset */
1997
1998         arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1999
2000         /* Let us now play a dirty trick: we will take arg1
2001            which is a value node pointing to the topmost level
2002            of the multidimensional array-set and pretend
2003            that it is actually a array of the final element
2004            type, this will ensure that value_subscript()
2005            returns the correct type value */
2006
2007         deprecated_set_value_type (arg1, tmp_type);
2008         return value_subscripted_rvalue (arg1, arg2, 0);
2009       }
2010
2011     case BINOP_LOGICAL_AND:
2012       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2013       if (noside == EVAL_SKIP)
2014         {
2015           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2016           goto nosideret;
2017         }
2018
2019       oldpos = *pos;
2020       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2021       *pos = oldpos;
2022
2023       if (binop_user_defined_p (op, arg1, arg2))
2024         {
2025           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2026           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2027         }
2028       else
2029         {
2030           tem = value_logical_not (arg1);
2031           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2032                                   (tem ? EVAL_SKIP : noside));
2033           type = language_bool_type (exp->language_defn, exp->gdbarch);
2034           return value_from_longest (type,
2035                              (LONGEST) (!tem && !value_logical_not (arg2)));
2036         }
2037
2038     case BINOP_LOGICAL_OR:
2039       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2040       if (noside == EVAL_SKIP)
2041         {
2042           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2043           goto nosideret;
2044         }
2045
2046       oldpos = *pos;
2047       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2048       *pos = oldpos;
2049
2050       if (binop_user_defined_p (op, arg1, arg2))
2051         {
2052           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2053           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2054         }
2055       else
2056         {
2057           tem = value_logical_not (arg1);
2058           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2059                                   (!tem ? EVAL_SKIP : noside));
2060           type = language_bool_type (exp->language_defn, exp->gdbarch);
2061           return value_from_longest (type,
2062                              (LONGEST) (!tem || !value_logical_not (arg2)));
2063         }
2064
2065     case BINOP_EQUAL:
2066       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2067       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2068       if (noside == EVAL_SKIP)
2069         goto nosideret;
2070       if (binop_user_defined_p (op, arg1, arg2))
2071         {
2072           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2073         }
2074       else
2075         {
2076           tem = value_equal (arg1, arg2);
2077           type = language_bool_type (exp->language_defn, exp->gdbarch);
2078           return value_from_longest (type, (LONGEST) tem);
2079         }
2080
2081     case BINOP_NOTEQUAL:
2082       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2083       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2084       if (noside == EVAL_SKIP)
2085         goto nosideret;
2086       if (binop_user_defined_p (op, arg1, arg2))
2087         {
2088           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2089         }
2090       else
2091         {
2092           tem = value_equal (arg1, arg2);
2093           type = language_bool_type (exp->language_defn, exp->gdbarch);
2094           return value_from_longest (type, (LONGEST) ! tem);
2095         }
2096
2097     case BINOP_LESS:
2098       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2099       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2100       if (noside == EVAL_SKIP)
2101         goto nosideret;
2102       if (binop_user_defined_p (op, arg1, arg2))
2103         {
2104           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2105         }
2106       else
2107         {
2108           tem = value_less (arg1, arg2);
2109           type = language_bool_type (exp->language_defn, exp->gdbarch);
2110           return value_from_longest (type, (LONGEST) tem);
2111         }
2112
2113     case BINOP_GTR:
2114       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2115       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2116       if (noside == EVAL_SKIP)
2117         goto nosideret;
2118       if (binop_user_defined_p (op, arg1, arg2))
2119         {
2120           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2121         }
2122       else
2123         {
2124           tem = value_less (arg2, arg1);
2125           type = language_bool_type (exp->language_defn, exp->gdbarch);
2126           return value_from_longest (type, (LONGEST) tem);
2127         }
2128
2129     case BINOP_GEQ:
2130       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2131       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2132       if (noside == EVAL_SKIP)
2133         goto nosideret;
2134       if (binop_user_defined_p (op, arg1, arg2))
2135         {
2136           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2137         }
2138       else
2139         {
2140           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2141           type = language_bool_type (exp->language_defn, exp->gdbarch);
2142           return value_from_longest (type, (LONGEST) tem);
2143         }
2144
2145     case BINOP_LEQ:
2146       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2147       arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2148       if (noside == EVAL_SKIP)
2149         goto nosideret;
2150       if (binop_user_defined_p (op, arg1, arg2))
2151         {
2152           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2153         }
2154       else
2155         {
2156           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2157           type = language_bool_type (exp->language_defn, exp->gdbarch);
2158           return value_from_longest (type, (LONGEST) tem);
2159         }
2160
2161     case BINOP_REPEAT:
2162       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2163       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2164       if (noside == EVAL_SKIP)
2165         goto nosideret;
2166       type = check_typedef (value_type (arg2));
2167       if (TYPE_CODE (type) != TYPE_CODE_INT)
2168         error (_("Non-integral right operand for \"@\" operator."));
2169       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2170         {
2171           return allocate_repeat_value (value_type (arg1),
2172                                      longest_to_int (value_as_long (arg2)));
2173         }
2174       else
2175         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2176
2177     case BINOP_COMMA:
2178       evaluate_subexp (NULL_TYPE, exp, pos, noside);
2179       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2180
2181     case UNOP_PLUS:
2182       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2183       if (noside == EVAL_SKIP)
2184         goto nosideret;
2185       if (unop_user_defined_p (op, arg1))
2186         return value_x_unop (arg1, op, noside);
2187       else
2188         return value_pos (arg1);
2189
2190     case UNOP_NEG:
2191       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2192       if (noside == EVAL_SKIP)
2193         goto nosideret;
2194       if (unop_user_defined_p (op, arg1))
2195         return value_x_unop (arg1, op, noside);
2196       else
2197         return value_neg (arg1);
2198
2199     case UNOP_COMPLEMENT:
2200       /* C++: check for and handle destructor names.  */
2201       op = exp->elts[*pos].opcode;
2202
2203       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2204       if (noside == EVAL_SKIP)
2205         goto nosideret;
2206       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2207         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2208       else
2209         return value_complement (arg1);
2210
2211     case UNOP_LOGICAL_NOT:
2212       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2213       if (noside == EVAL_SKIP)
2214         goto nosideret;
2215       if (unop_user_defined_p (op, arg1))
2216         return value_x_unop (arg1, op, noside);
2217       else
2218         {
2219           type = language_bool_type (exp->language_defn, exp->gdbarch);
2220           return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2221         }
2222
2223     case UNOP_IND:
2224       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2225         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2226       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2227       type = check_typedef (value_type (arg1));
2228       if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2229           || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2230         error (_("Attempt to dereference pointer to member without an object"));
2231       if (noside == EVAL_SKIP)
2232         goto nosideret;
2233       if (unop_user_defined_p (op, arg1))
2234         return value_x_unop (arg1, op, noside);
2235       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2236         {
2237           type = check_typedef (value_type (arg1));
2238           if (TYPE_CODE (type) == TYPE_CODE_PTR
2239               || TYPE_CODE (type) == TYPE_CODE_REF
2240           /* In C you can dereference an array to get the 1st elt.  */
2241               || TYPE_CODE (type) == TYPE_CODE_ARRAY
2242             )
2243             return value_zero (TYPE_TARGET_TYPE (type),
2244                                lval_memory);
2245           else if (TYPE_CODE (type) == TYPE_CODE_INT)
2246             /* GDB allows dereferencing an int.  */
2247             return value_zero (builtin_type_int, lval_memory);
2248           else
2249             error (_("Attempt to take contents of a non-pointer value."));
2250         }
2251       return value_ind (arg1);
2252
2253     case UNOP_ADDR:
2254       /* C++: check for and handle pointer to members.  */
2255
2256       op = exp->elts[*pos].opcode;
2257
2258       if (noside == EVAL_SKIP)
2259         {
2260           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2261           goto nosideret;
2262         }
2263       else
2264         {
2265           struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
2266           return retvalp;
2267         }
2268
2269     case UNOP_SIZEOF:
2270       if (noside == EVAL_SKIP)
2271         {
2272           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2273           goto nosideret;
2274         }
2275       return evaluate_subexp_for_sizeof (exp, pos);
2276
2277     case UNOP_CAST:
2278       (*pos) += 2;
2279       type = exp->elts[pc + 1].type;
2280       arg1 = evaluate_subexp (type, exp, pos, noside);
2281       if (noside == EVAL_SKIP)
2282         goto nosideret;
2283       if (type != value_type (arg1))
2284         arg1 = value_cast (type, arg1);
2285       return arg1;
2286
2287     case UNOP_MEMVAL:
2288       (*pos) += 2;
2289       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2290       if (noside == EVAL_SKIP)
2291         goto nosideret;
2292       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2293         return value_zero (exp->elts[pc + 1].type, lval_memory);
2294       else
2295         return value_at_lazy (exp->elts[pc + 1].type,
2296                               value_as_address (arg1));
2297
2298     case UNOP_MEMVAL_TLS:
2299       (*pos) += 3;
2300       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2301       if (noside == EVAL_SKIP)
2302         goto nosideret;
2303       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2304         return value_zero (exp->elts[pc + 2].type, lval_memory);
2305       else
2306         {
2307           CORE_ADDR tls_addr;
2308           tls_addr = target_translate_tls_address (exp->elts[pc + 1].objfile,
2309                                                    value_as_address (arg1));
2310           return value_at_lazy (exp->elts[pc + 2].type, tls_addr);
2311         }
2312
2313     case UNOP_PREINCREMENT:
2314       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2315       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2316         return arg1;
2317       else if (unop_user_defined_p (op, arg1))
2318         {
2319           return value_x_unop (arg1, op, noside);
2320         }
2321       else
2322         {
2323           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2324           if (ptrmath_type_p (value_type (arg1)))
2325             arg2 = value_ptradd (arg1, arg2);
2326           else
2327             arg2 = value_binop (arg1, arg2, BINOP_ADD);
2328
2329           return value_assign (arg1, arg2);
2330         }
2331
2332     case UNOP_PREDECREMENT:
2333       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2334       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2335         return arg1;
2336       else if (unop_user_defined_p (op, arg1))
2337         {
2338           return value_x_unop (arg1, op, noside);
2339         }
2340       else
2341         {
2342           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2343           if (ptrmath_type_p (value_type (arg1)))
2344             arg2 = value_ptrsub (arg1, arg2);
2345           else
2346             arg2 = value_binop (arg1, arg2, BINOP_SUB);
2347
2348           return value_assign (arg1, arg2);
2349         }
2350
2351     case UNOP_POSTINCREMENT:
2352       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2353       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2354         return arg1;
2355       else if (unop_user_defined_p (op, arg1))
2356         {
2357           return value_x_unop (arg1, op, noside);
2358         }
2359       else
2360         {
2361           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2362           if (ptrmath_type_p (value_type (arg1)))
2363             arg2 = value_ptradd (arg1, arg2);
2364           else
2365             arg2 = value_binop (arg1, arg2, BINOP_ADD);
2366
2367           value_assign (arg1, arg2);
2368           return arg1;
2369         }
2370
2371     case UNOP_POSTDECREMENT:
2372       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2373       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2374         return arg1;
2375       else if (unop_user_defined_p (op, arg1))
2376         {
2377           return value_x_unop (arg1, op, noside);
2378         }
2379       else
2380         {
2381           arg2 = value_from_longest (builtin_type_uint8, (LONGEST) 1);
2382           if (ptrmath_type_p (value_type (arg1)))
2383             arg2 = value_ptrsub (arg1, arg2);
2384           else
2385             arg2 = value_binop (arg1, arg2, BINOP_SUB);
2386
2387           value_assign (arg1, arg2);
2388           return arg1;
2389         }
2390
2391     case OP_THIS:
2392       (*pos) += 1;
2393       return value_of_this (1);
2394
2395     case OP_OBJC_SELF:
2396       (*pos) += 1;
2397       return value_of_local ("self", 1);
2398
2399     case OP_TYPE:
2400       /* The value is not supposed to be used.  This is here to make it
2401          easier to accommodate expressions that contain types.  */
2402       (*pos) += 2;
2403       if (noside == EVAL_SKIP)
2404         goto nosideret;
2405       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2406         return allocate_value (exp->elts[pc + 1].type);
2407       else
2408         error (_("Attempt to use a type name as an expression"));
2409
2410     default:
2411       /* Removing this case and compiling with gcc -Wall reveals that
2412          a lot of cases are hitting this case.  Some of these should
2413          probably be removed from expression.h; others are legitimate
2414          expressions which are (apparently) not fully implemented.
2415
2416          If there are any cases landing here which mean a user error,
2417          then they should be separate cases, with more descriptive
2418          error messages.  */
2419
2420       error (_("\
2421 GDB does not (yet) know how to evaluate that kind of expression"));
2422     }
2423
2424 nosideret:
2425   return value_from_longest (builtin_type_long, (LONGEST) 1);
2426 }
2427 \f
2428 /* Evaluate a subexpression of EXP, at index *POS,
2429    and return the address of that subexpression.
2430    Advance *POS over the subexpression.
2431    If the subexpression isn't an lvalue, get an error.
2432    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2433    then only the type of the result need be correct.  */
2434
2435 static struct value *
2436 evaluate_subexp_for_address (struct expression *exp, int *pos,
2437                              enum noside noside)
2438 {
2439   enum exp_opcode op;
2440   int pc;
2441   struct symbol *var;
2442   struct value *x;
2443   int tem;
2444
2445   pc = (*pos);
2446   op = exp->elts[pc].opcode;
2447
2448   switch (op)
2449     {
2450     case UNOP_IND:
2451       (*pos)++;
2452       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2453
2454       /* We can't optimize out "&*" if there's a user-defined operator*.  */
2455       if (unop_user_defined_p (op, x))
2456         {
2457           x = value_x_unop (x, op, noside);
2458           goto default_case_after_eval;
2459         }
2460
2461       return x;
2462
2463     case UNOP_MEMVAL:
2464       (*pos) += 3;
2465       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2466                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
2467
2468     case OP_VAR_VALUE:
2469       var = exp->elts[pc + 2].symbol;
2470
2471       /* C++: The "address" of a reference should yield the address
2472        * of the object pointed to. Let value_addr() deal with it. */
2473       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2474         goto default_case;
2475
2476       (*pos) += 4;
2477       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2478         {
2479           struct type *type =
2480           lookup_pointer_type (SYMBOL_TYPE (var));
2481           enum address_class sym_class = SYMBOL_CLASS (var);
2482
2483           if (sym_class == LOC_CONST
2484               || sym_class == LOC_CONST_BYTES
2485               || sym_class == LOC_REGISTER)
2486             error (_("Attempt to take address of register or constant."));
2487
2488           return
2489             value_zero (type, not_lval);
2490         }
2491       else if (symbol_read_needs_frame (var))
2492         return
2493           locate_var_value
2494           (var,
2495            block_innermost_frame (exp->elts[pc + 1].block));
2496       else
2497         return locate_var_value (var, NULL);
2498
2499     case OP_SCOPE:
2500       tem = longest_to_int (exp->elts[pc + 2].longconst);
2501       (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2502       x = value_aggregate_elt (exp->elts[pc + 1].type,
2503                                &exp->elts[pc + 3].string,
2504                                1, noside);
2505       if (x == NULL)
2506         error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2507       return x;
2508
2509     default:
2510     default_case:
2511       x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2512     default_case_after_eval:
2513       if (noside == EVAL_AVOID_SIDE_EFFECTS)
2514         {
2515           struct type *type = check_typedef (value_type (x));
2516
2517           if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2518             return value_zero (lookup_pointer_type (value_type (x)),
2519                                not_lval);
2520           else if (TYPE_CODE (type) == TYPE_CODE_REF)
2521             return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2522                                not_lval);
2523           else
2524             error (_("Attempt to take address of value not located in memory."));
2525         }
2526       return value_addr (x);
2527     }
2528 }
2529
2530 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2531    When used in contexts where arrays will be coerced anyway, this is
2532    equivalent to `evaluate_subexp' but much faster because it avoids
2533    actually fetching array contents (perhaps obsolete now that we have
2534    value_lazy()).
2535
2536    Note that we currently only do the coercion for C expressions, where
2537    arrays are zero based and the coercion is correct.  For other languages,
2538    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
2539    to decide if coercion is appropriate.
2540
2541  */
2542
2543 struct value *
2544 evaluate_subexp_with_coercion (struct expression *exp,
2545                                int *pos, enum noside noside)
2546 {
2547   enum exp_opcode op;
2548   int pc;
2549   struct value *val;
2550   struct symbol *var;
2551
2552   pc = (*pos);
2553   op = exp->elts[pc].opcode;
2554
2555   switch (op)
2556     {
2557     case OP_VAR_VALUE:
2558       var = exp->elts[pc + 2].symbol;
2559       if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
2560           && CAST_IS_CONVERSION)
2561         {
2562           (*pos) += 4;
2563           val =
2564             locate_var_value
2565             (var, block_innermost_frame (exp->elts[pc + 1].block));
2566           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
2567                              val);
2568         }
2569       /* FALLTHROUGH */
2570
2571     default:
2572       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2573     }
2574 }
2575
2576 /* Evaluate a subexpression of EXP, at index *POS,
2577    and return a value for the size of that subexpression.
2578    Advance *POS over the subexpression.  */
2579
2580 static struct value *
2581 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2582 {
2583   /* FIXME: This should be size_t.  */
2584   struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
2585   enum exp_opcode op;
2586   int pc;
2587   struct type *type;
2588   struct value *val;
2589
2590   pc = (*pos);
2591   op = exp->elts[pc].opcode;
2592
2593   switch (op)
2594     {
2595       /* This case is handled specially
2596          so that we avoid creating a value for the result type.
2597          If the result type is very big, it's desirable not to
2598          create a value unnecessarily.  */
2599     case UNOP_IND:
2600       (*pos)++;
2601       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2602       type = check_typedef (value_type (val));
2603       if (TYPE_CODE (type) != TYPE_CODE_PTR
2604           && TYPE_CODE (type) != TYPE_CODE_REF
2605           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2606         error (_("Attempt to take contents of a non-pointer value."));
2607       type = check_typedef (TYPE_TARGET_TYPE (type));
2608       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2609
2610     case UNOP_MEMVAL:
2611       (*pos) += 3;
2612       type = check_typedef (exp->elts[pc + 1].type);
2613       return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2614
2615     case OP_VAR_VALUE:
2616       (*pos) += 4;
2617       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2618       return
2619         value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
2620
2621     default:
2622       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2623       return value_from_longest (size_type,
2624                                  (LONGEST) TYPE_LENGTH (value_type (val)));
2625     }
2626 }
2627
2628 /* Parse a type expression in the string [P..P+LENGTH). */
2629
2630 struct type *
2631 parse_and_eval_type (char *p, int length)
2632 {
2633   char *tmp = (char *) alloca (length + 4);
2634   struct expression *expr;
2635   tmp[0] = '(';
2636   memcpy (tmp + 1, p, length);
2637   tmp[length + 1] = ')';
2638   tmp[length + 2] = '0';
2639   tmp[length + 3] = '\0';
2640   expr = parse_expression (tmp);
2641   if (expr->elts[0].opcode != UNOP_CAST)
2642     error (_("Internal error in eval_type."));
2643   return expr->elts[1].type;
2644 }
2645
2646 int
2647 calc_f77_array_dims (struct type *array_type)
2648 {
2649   int ndimen = 1;
2650   struct type *tmp_type;
2651
2652   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2653     error (_("Can't get dimensions for a non-array type"));
2654
2655   tmp_type = array_type;
2656
2657   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2658     {
2659       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2660         ++ndimen;
2661     }
2662   return ndimen;
2663 }