gdb/eval.c

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