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