gdb/eval.c

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