gdb/eval.c

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