gdb/eval.c

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