gdb/eval.c

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