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 (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 (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 (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 (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]
 836             = value_from_pointer (VALUE_TYPE (temp),
 837                                   VALUE_ADDRESS (temp) + VALUE_OFFSET (temp));
 838           /* Name of method from expression */
 839           strcpy (tstr, &exp->elts[pc2 + 2].string);
 840
 841           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
 842             {
 843               /* Language is C++, do some overload resolution before evaluation */
 844               value_ptr valp = NULL;
 845
 846               /* Prepare list of argument types for overload resolution */
 847               arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
 848               for (ix = 1; ix <= nargs; ix++)
 849                 arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
 850
 851               (void) find_overload_match (arg_types, nargs, tstr,
 852                                      1 /* method */ , 0 /* strict match */ ,
 853                                           arg2 /* the object */ , NULL,
 854                                           &valp, NULL, &static_memfuncp);
 855
 856
 857               argvec[1] = arg2; /* the ``this'' pointer */
 858               argvec[0] = valp; /* use the method found after overload resolution */
 859             }
 860           else
 861             /* Non-C++ case -- or no overload resolution */
 862             {
 863               temp = arg2;
 864               argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
 865                                             &static_memfuncp,
 866                                             op == STRUCTOP_STRUCT
 867                                        ? "structure" : "structure pointer");
 868               argvec[1] = arg2; /* the ``this'' pointer */
 869             }
 870
 871           if (static_memfuncp)
 872             {
 873               argvec[1] = argvec[0];
 874               nargs--;
 875               argvec++;
 876             }
 877         }
 878       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
 879         {
 880           argvec[1] = arg2;
 881           argvec[0] = arg1;
 882         }
 883       else if (op == OP_VAR_VALUE)
 884         {
 885           /* Non-member function being called */
 886           /* fn: This can only be done for C++ functions.  A C-style function
 887              in a C++ program, for instance, does not have the fields that
 888              are expected here */
 889
 890           if (overload_resolution && (exp->language_defn->la_language == language_cplus))
 891             {
 892               /* Language is C++, do some overload resolution before evaluation */
 893               struct symbol *symp;
 894
 895               /* Prepare list of argument types for overload resolution */
 896               arg_types = (struct type **) xmalloc (nargs * (sizeof (struct type *)));
 897               for (ix = 1; ix <= nargs; ix++)
 898                 arg_types[ix - 1] = VALUE_TYPE (argvec[ix]);
 899
 900               (void) find_overload_match (arg_types, nargs, NULL /* no need for name */ ,
 901                                  0 /* not method */ , 0 /* strict match */ ,
 902                       NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
 903                                           NULL, &symp, NULL);
 904
 905               /* Now fix the expression being evaluated */
 906               exp->elts[save_pos1+2].symbol = symp;
 907               argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
 908             }
 909           else
 910             {
 911               /* Not C++, or no overload resolution allowed */
 912               /* nothing to be done; argvec already correctly set up */
 913             }
 914         }
 915       else
 916         {
 917           /* It is probably a C-style function */
 918           /* nothing to be done; argvec already correctly set up */
 919         }
 920
 921     do_call_it:
 922
 923       if (noside == EVAL_SKIP)
 924         goto nosideret;
 925       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 926         {
 927           /* If the return type doesn't look like a function type, call an
 928              error.  This can happen if somebody tries to turn a variable into
 929              a function call. This is here because people often want to
 930              call, eg, strcmp, which gdb doesn't know is a function.  If
 931              gdb isn't asked for it's opinion (ie. through "whatis"),
 932              it won't offer it. */
 933
 934           struct type *ftype =
 935           TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
 936
 937           if (ftype)
 938             return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
 939           else
 940             error ("Expression of type other than \"Function returning ...\" used as function");
 941         }
 942       if (argvec[0] == NULL)
 943         error ("Cannot evaluate function -- may be inlined");
 944       return call_function_by_hand (argvec[0], nargs, argvec + 1);
 945       /* pai: FIXME save value from call_function_by_hand, then adjust pc by adjust_fn_pc if +ve  */
 946
 947     case OP_F77_UNDETERMINED_ARGLIST:
 948
 949       /* Remember that in F77, functions, substring ops and
 950          array subscript operations cannot be disambiguated
 951          at parse time.  We have made all array subscript operations,
 952          substring operations as well as function calls  come here
 953          and we now have to discover what the heck this thing actually was.
 954          If it is a function, we process just as if we got an OP_FUNCALL. */
 955
 956       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 957       (*pos) += 2;
 958
 959       /* First determine the type code we are dealing with.  */
 960       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 961       type = check_typedef (VALUE_TYPE (arg1));
 962       code = TYPE_CODE (type);
 963
 964       switch (code)
 965         {
 966         case TYPE_CODE_ARRAY:
 967           goto multi_f77_subscript;
 968
 969         case TYPE_CODE_STRING:
 970           goto op_f77_substr;
 971
 972         case TYPE_CODE_PTR:
 973         case TYPE_CODE_FUNC:
 974           /* It's a function call. */
 975           /* Allocate arg vector, including space for the function to be
 976              called in argvec[0] and a terminating NULL */
 977           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 978           argvec[0] = arg1;
 979           tem = 1;
 980           for (; tem <= nargs; tem++)
 981             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 982           argvec[tem] = 0;      /* signal end of arglist */
 983           goto do_call_it;
 984
 985         default:
 986           error ("Cannot perform substring on this type");
 987         }
 988
 989     op_f77_substr:
 990       /* We have a substring operation on our hands here,
 991          let us get the string we will be dealing with */
 992
 993       /* Now evaluate the 'from' and 'to' */
 994
 995       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 996
 997       if (nargs < 2)
 998         return value_subscript (arg1, arg2);
 999
1000       arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
1001
1002       if (noside == EVAL_SKIP)
1003         goto nosideret;
1004
1005       tem2 = value_as_long (arg2);
1006       tem3 = value_as_long (arg3);
1007
1008       return value_slice (arg1, tem2, tem3 - tem2 + 1);
1009
1010     case OP_COMPLEX:
1011       /* We have a complex number, There should be 2 floating
1012          point numbers that compose it */
1013       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1014       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1015
1016       return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
1017
1018     case STRUCTOP_STRUCT:
1019       tem = longest_to_int (exp->elts[pc + 1].longconst);
1020       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1021       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1022       if (noside == EVAL_SKIP)
1023         goto nosideret;
1024       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1025         return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
1026                                                    &exp->elts[pc + 2].string,
1027                                                    0),
1028                            lval_memory);
1029       else
1030         {
1031           value_ptr temp = arg1;
1032           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1033                                    NULL, "structure");
1034         }
1035
1036     case STRUCTOP_PTR:
1037       tem = longest_to_int (exp->elts[pc + 1].longconst);
1038       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1039       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1040       if (noside == EVAL_SKIP)
1041         goto nosideret;
1042
1043       /* JYG: if print object is on we need to replace the base type
1044          with rtti type in order to continue on with successful
1045          lookup of member / method only available in the rtti type. */
1046       {
1047         struct type *type = VALUE_TYPE (arg1);
1048         struct type *real_type;
1049         int full, top, using_enc;
1050
1051         if (objectprint && TYPE_TARGET_TYPE(type) &&
1052             (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
1053           {
1054             real_type = value_rtti_target_type (arg1, &full, &top, &using_enc);
1055             if (real_type)
1056               {
1057                 if (TYPE_CODE (type) == TYPE_CODE_PTR)
1058                   real_type = lookup_pointer_type (real_type);
1059                 else
1060                   real_type = lookup_reference_type (real_type);
1061
1062                 arg1 = value_cast (real_type, arg1);
1063               }
1064           }
1065       }
1066
1067       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1068         return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
1069                                                    &exp->elts[pc + 2].string,
1070                                                    0),
1071                            lval_memory);
1072       else
1073         {
1074           value_ptr temp = arg1;
1075           return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
1076                                    NULL, "structure pointer");
1077         }
1078
1079     case STRUCTOP_MEMBER:
1080       arg1 = evaluate_subexp_for_address (exp, pos, noside);
1081       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1082
1083       /* With HP aCC, pointers to methods do not point to the function code */
1084       if (hp_som_som_object_present &&
1085           (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
1086       (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
1087         error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
1088
1089       mem_offset = value_as_long (arg2);
1090       goto handle_pointer_to_member;
1091
1092     case STRUCTOP_MPTR:
1093       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1094       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1095
1096       /* With HP aCC, pointers to methods do not point to the function code */
1097       if (hp_som_som_object_present &&
1098           (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_PTR) &&
1099       (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg2))) == TYPE_CODE_METHOD))
1100         error ("Pointers to methods not supported with HP aCC");        /* 1997-08-19 */
1101
1102       mem_offset = value_as_long (arg2);
1103
1104     handle_pointer_to_member:
1105       /* HP aCC generates offsets that have bit #29 set; turn it off to get
1106          a real offset to the member. */
1107       if (hp_som_som_object_present)
1108         {
1109           if (!mem_offset)      /* no bias -> really null */
1110             error ("Attempted dereference of null pointer-to-member");
1111           mem_offset &= ~0x20000000;
1112         }
1113       if (noside == EVAL_SKIP)
1114         goto nosideret;
1115       type = check_typedef (VALUE_TYPE (arg2));
1116       if (TYPE_CODE (type) != TYPE_CODE_PTR)
1117         goto bad_pointer_to_member;
1118       type = check_typedef (TYPE_TARGET_TYPE (type));
1119       if (TYPE_CODE (type) == TYPE_CODE_METHOD)
1120         error ("not implemented: pointer-to-method in pointer-to-member construct");
1121       if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
1122         goto bad_pointer_to_member;
1123       /* Now, convert these values to an address.  */
1124       arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
1125                          arg1);
1126       arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1127                                  value_as_long (arg1) + mem_offset);
1128       return value_ind (arg3);
1129     bad_pointer_to_member:
1130       error ("non-pointer-to-member value used in pointer-to-member construct");
1131
1132     case BINOP_CONCAT:
1133       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1134       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1135       if (noside == EVAL_SKIP)
1136         goto nosideret;
1137       if (binop_user_defined_p (op, arg1, arg2))
1138         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1139       else
1140         return value_concat (arg1, arg2);
1141
1142     case BINOP_ASSIGN:
1143       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1144       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1145
1146       /* Do special stuff for HP aCC pointers to members */
1147       if (hp_som_som_object_present)
1148         {
1149           /* 1997-08-19 Can't assign HP aCC pointers to methods. No details of
1150              the implementation yet; but the pointer appears to point to a code
1151              sequence (thunk) in memory -- in any case it is *not* the address
1152              of the function as it would be in a naive implementation. */
1153           if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
1154               (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD))
1155             error ("Assignment to pointers to methods not implemented with HP aCC");
1156
1157           /* HP aCC pointers to data members require a constant bias */
1158           if ((TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR) &&
1159               (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER))
1160             {
1161               unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (arg2);       /* forces evaluation */
1162               *ptr |= 0x20000000;       /* set 29th bit */
1163             }
1164         }
1165
1166       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1167         return arg1;
1168       if (binop_user_defined_p (op, arg1, arg2))
1169         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1170       else
1171         return value_assign (arg1, arg2);
1172
1173     case BINOP_ASSIGN_MODIFY:
1174       (*pos) += 2;
1175       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1176       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1177       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1178         return arg1;
1179       op = exp->elts[pc + 1].opcode;
1180       if (binop_user_defined_p (op, arg1, arg2))
1181         return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
1182       else if (op == BINOP_ADD)
1183         arg2 = value_add (arg1, arg2);
1184       else if (op == BINOP_SUB)
1185         arg2 = value_sub (arg1, arg2);
1186       else
1187         arg2 = value_binop (arg1, arg2, op);
1188       return value_assign (arg1, arg2);
1189
1190     case BINOP_ADD:
1191       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1192       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1193       if (noside == EVAL_SKIP)
1194         goto nosideret;
1195       if (binop_user_defined_p (op, arg1, arg2))
1196         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1197       else
1198         return value_add (arg1, arg2);
1199
1200     case BINOP_SUB:
1201       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1202       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1203       if (noside == EVAL_SKIP)
1204         goto nosideret;
1205       if (binop_user_defined_p (op, arg1, arg2))
1206         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1207       else
1208         return value_sub (arg1, arg2);
1209
1210     case BINOP_MUL:
1211     case BINOP_DIV:
1212     case BINOP_REM:
1213     case BINOP_MOD:
1214     case BINOP_LSH:
1215     case BINOP_RSH:
1216     case BINOP_BITWISE_AND:
1217     case BINOP_BITWISE_IOR:
1218     case BINOP_BITWISE_XOR:
1219       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1220       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1221       if (noside == EVAL_SKIP)
1222         goto nosideret;
1223       if (binop_user_defined_p (op, arg1, arg2))
1224         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1225       else if (noside == EVAL_AVOID_SIDE_EFFECTS
1226                && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
1227         return value_zero (VALUE_TYPE (arg1), not_lval);
1228       else
1229         return value_binop (arg1, arg2, op);
1230
1231     case BINOP_RANGE:
1232       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1233       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1234       if (noside == EVAL_SKIP)
1235         goto nosideret;
1236       error ("':' operator used in invalid context");
1237
1238     case BINOP_SUBSCRIPT:
1239       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1240       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1241       if (noside == EVAL_SKIP)
1242         goto nosideret;
1243       if (binop_user_defined_p (op, arg1, arg2))
1244         return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1245       else
1246         {
1247           /* If the user attempts to subscript something that is not an
1248              array or pointer type (like a plain int variable for example),
1249              then report this as an error. */
1250
1251           COERCE_REF (arg1);
1252           type = check_typedef (VALUE_TYPE (arg1));
1253           if (TYPE_CODE (type) != TYPE_CODE_ARRAY
1254               && TYPE_CODE (type) != TYPE_CODE_PTR)
1255             {
1256               if (TYPE_NAME (type))
1257                 error ("cannot subscript something of type `%s'",
1258                        TYPE_NAME (type));
1259               else
1260                 error ("cannot subscript requested type");
1261             }
1262
1263           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1264             return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
1265           else
1266             return value_subscript (arg1, arg2);
1267         }
1268
1269     case BINOP_IN:
1270       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1271       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1272       if (noside == EVAL_SKIP)
1273         goto nosideret;
1274       return value_in (arg1, arg2);
1275
1276     case MULTI_SUBSCRIPT:
1277       (*pos) += 2;
1278       nargs = longest_to_int (exp->elts[pc + 1].longconst);
1279       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
1280       while (nargs-- > 0)
1281         {
1282           arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1283           /* FIXME:  EVAL_SKIP handling may not be correct. */
1284           if (noside == EVAL_SKIP)
1285             {
1286               if (nargs > 0)
1287                 {
1288                   continue;
1289                 }
1290               else
1291                 {
1292                   goto nosideret;
1293                 }
1294             }
1295           /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
1296           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1297             {
1298               /* If the user attempts to subscript something that has no target
1299                  type (like a plain int variable for example), then report this
1300                  as an error. */
1301
1302               type = TYPE_TARGET_TYPE (check_typedef (VALUE_TYPE (arg1)));
1303               if (type != NULL)
1304                 {
1305                   arg1 = value_zero (type, VALUE_LVAL (arg1));
1306                   noside = EVAL_SKIP;
1307                   continue;
1308                 }
1309               else
1310                 {
1311                   error ("cannot subscript something of type `%s'",
1312                          TYPE_NAME (VALUE_TYPE (arg1)));
1313                 }
1314             }
1315
1316           if (binop_user_defined_p (op, arg1, arg2))
1317             {
1318               arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
1319             }
1320           else
1321             {
1322               arg1 = value_subscript (arg1, arg2);
1323             }
1324         }
1325       return (arg1);
1326
1327     multi_f77_subscript:
1328       {
1329         int subscript_array[MAX_FORTRAN_DIMS + 1];      /* 1-based array of
1330                                                            subscripts, max == 7 */
1331         int array_size_array[MAX_FORTRAN_DIMS + 1];
1332         int ndimensions = 1, i;
1333         struct type *tmp_type;
1334         int offset_item;        /* The array offset where the item lives */
1335
1336         if (nargs > MAX_FORTRAN_DIMS)
1337           error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
1338
1339         tmp_type = check_typedef (VALUE_TYPE (arg1));
1340         ndimensions = calc_f77_array_dims (type);
1341
1342         if (nargs != ndimensions)
1343           error ("Wrong number of subscripts");
1344
1345         /* Now that we know we have a legal array subscript expression
1346            let us actually find out where this element exists in the array. */
1347
1348         offset_item = 0;
1349         for (i = 1; i <= nargs; i++)
1350           {
1351             /* Evaluate each subscript, It must be a legal integer in F77 */
1352             arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1353
1354             /* Fill in the subscript and array size arrays */
1355
1356             subscript_array[i] = value_as_long (arg2);
1357
1358             retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1359             if (retcode == BOUND_FETCH_ERROR)
1360               error ("Cannot obtain dynamic upper bound");
1361
1362             retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1363             if (retcode == BOUND_FETCH_ERROR)
1364               error ("Cannot obtain dynamic lower bound");
1365
1366             array_size_array[i] = upper - lower + 1;
1367
1368             /* Zero-normalize subscripts so that offsetting will work. */
1369
1370             subscript_array[i] -= lower;
1371
1372             /* If we are at the bottom of a multidimensional
1373                array type then keep a ptr to the last ARRAY
1374                type around for use when calling value_subscript()
1375                below. This is done because we pretend to value_subscript
1376                that we actually have a one-dimensional array
1377                of base element type that we apply a simple
1378                offset to. */
1379
1380             if (i < nargs)
1381               tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1382           }
1383
1384         /* Now let us calculate the offset for this item */
1385
1386         offset_item = subscript_array[ndimensions];
1387
1388         for (i = ndimensions - 1; i >= 1; i--)
1389           offset_item =
1390             array_size_array[i] * offset_item + subscript_array[i];
1391
1392         /* Construct a value node with the value of the offset */
1393
1394         arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1395
1396         /* Let us now play a dirty trick: we will take arg1
1397            which is a value node pointing to the topmost level
1398            of the multidimensional array-set and pretend
1399            that it is actually a array of the final element
1400            type, this will ensure that value_subscript()
1401            returns the correct type value */
1402
1403         VALUE_TYPE (arg1) = tmp_type;
1404         return value_ind (value_add (value_coerce_array (arg1), arg2));
1405       }
1406
1407     case BINOP_LOGICAL_AND:
1408       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1409       if (noside == EVAL_SKIP)
1410         {
1411           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1412           goto nosideret;
1413         }
1414
1415       oldpos = *pos;
1416       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1417       *pos = oldpos;
1418
1419       if (binop_user_defined_p (op, arg1, arg2))
1420         {
1421           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1422           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1423         }
1424       else
1425         {
1426           tem = value_logical_not (arg1);
1427           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1428                                   (tem ? EVAL_SKIP : noside));
1429           return value_from_longest (LA_BOOL_TYPE,
1430                              (LONGEST) (!tem && !value_logical_not (arg2)));
1431         }
1432
1433     case BINOP_LOGICAL_OR:
1434       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1435       if (noside == EVAL_SKIP)
1436         {
1437           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1438           goto nosideret;
1439         }
1440
1441       oldpos = *pos;
1442       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1443       *pos = oldpos;
1444
1445       if (binop_user_defined_p (op, arg1, arg2))
1446         {
1447           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1448           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1449         }
1450       else
1451         {
1452           tem = value_logical_not (arg1);
1453           arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1454                                   (!tem ? EVAL_SKIP : noside));
1455           return value_from_longest (LA_BOOL_TYPE,
1456                              (LONGEST) (!tem || !value_logical_not (arg2)));
1457         }
1458
1459     case BINOP_EQUAL:
1460       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1461       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1462       if (noside == EVAL_SKIP)
1463         goto nosideret;
1464       if (binop_user_defined_p (op, arg1, arg2))
1465         {
1466           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1467         }
1468       else
1469         {
1470           tem = value_equal (arg1, arg2);
1471           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1472         }
1473
1474     case BINOP_NOTEQUAL:
1475       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1476       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1477       if (noside == EVAL_SKIP)
1478         goto nosideret;
1479       if (binop_user_defined_p (op, arg1, arg2))
1480         {
1481           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1482         }
1483       else
1484         {
1485           tem = value_equal (arg1, arg2);
1486           return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
1487         }
1488
1489     case BINOP_LESS:
1490       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1491       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1492       if (noside == EVAL_SKIP)
1493         goto nosideret;
1494       if (binop_user_defined_p (op, arg1, arg2))
1495         {
1496           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1497         }
1498       else
1499         {
1500           tem = value_less (arg1, arg2);
1501           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1502         }
1503
1504     case BINOP_GTR:
1505       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1506       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1507       if (noside == EVAL_SKIP)
1508         goto nosideret;
1509       if (binop_user_defined_p (op, arg1, arg2))
1510         {
1511           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1512         }
1513       else
1514         {
1515           tem = value_less (arg2, arg1);
1516           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1517         }
1518
1519     case BINOP_GEQ:
1520       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1521       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1522       if (noside == EVAL_SKIP)
1523         goto nosideret;
1524       if (binop_user_defined_p (op, arg1, arg2))
1525         {
1526           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1527         }
1528       else
1529         {
1530           tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1531           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1532         }
1533
1534     case BINOP_LEQ:
1535       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1536       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1537       if (noside == EVAL_SKIP)
1538         goto nosideret;
1539       if (binop_user_defined_p (op, arg1, arg2))
1540         {
1541           return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1542         }
1543       else
1544         {
1545           tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1546           return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1547         }
1548
1549     case BINOP_REPEAT:
1550       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1551       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1552       if (noside == EVAL_SKIP)
1553         goto nosideret;
1554       type = check_typedef (VALUE_TYPE (arg2));
1555       if (TYPE_CODE (type) != TYPE_CODE_INT)
1556         error ("Non-integral right operand for \"@\" operator.");
1557       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1558         {
1559           return allocate_repeat_value (VALUE_TYPE (arg1),
1560                                      longest_to_int (value_as_long (arg2)));
1561         }
1562       else
1563         return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1564
1565     case BINOP_COMMA:
1566       evaluate_subexp (NULL_TYPE, exp, pos, noside);
1567       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1568
1569     case UNOP_NEG:
1570       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1571       if (noside == EVAL_SKIP)
1572         goto nosideret;
1573       if (unop_user_defined_p (op, arg1))
1574         return value_x_unop (arg1, op, noside);
1575       else
1576         return value_neg (arg1);
1577
1578     case UNOP_COMPLEMENT:
1579       /* C++: check for and handle destructor names.  */
1580       op = exp->elts[*pos].opcode;
1581
1582       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1583       if (noside == EVAL_SKIP)
1584         goto nosideret;
1585       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1586         return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1587       else
1588         return value_complement (arg1);
1589
1590     case UNOP_LOGICAL_NOT:
1591       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1592       if (noside == EVAL_SKIP)
1593         goto nosideret;
1594       if (unop_user_defined_p (op, arg1))
1595         return value_x_unop (arg1, op, noside);
1596       else
1597         return value_from_longest (LA_BOOL_TYPE,
1598                                    (LONGEST) value_logical_not (arg1));
1599
1600     case UNOP_IND:
1601       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1602         expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1603       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1604       if ((TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) &&
1605           ((TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD) ||
1606            (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER)))
1607         error ("Attempt to dereference pointer to member without an object");
1608       if (noside == EVAL_SKIP)
1609         goto nosideret;
1610       if (unop_user_defined_p (op, arg1))
1611         return value_x_unop (arg1, op, noside);
1612       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1613         {
1614           type = check_typedef (VALUE_TYPE (arg1));
1615           if (TYPE_CODE (type) == TYPE_CODE_PTR
1616               || TYPE_CODE (type) == TYPE_CODE_REF
1617           /* In C you can dereference an array to get the 1st elt.  */
1618               || TYPE_CODE (type) == TYPE_CODE_ARRAY
1619             )
1620             return value_zero (TYPE_TARGET_TYPE (type),
1621                                lval_memory);
1622           else if (TYPE_CODE (type) == TYPE_CODE_INT)
1623             /* GDB allows dereferencing an int.  */
1624             return value_zero (builtin_type_int, lval_memory);
1625           else
1626             error ("Attempt to take contents of a non-pointer value.");
1627         }
1628       return value_ind (arg1);
1629
1630     case UNOP_ADDR:
1631       /* C++: check for and handle pointer to members.  */
1632
1633       op = exp->elts[*pos].opcode;
1634
1635       if (noside == EVAL_SKIP)
1636         {
1637           if (op == OP_SCOPE)
1638             {
1639               int temm = longest_to_int (exp->elts[pc + 3].longconst);
1640               (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
1641             }
1642           else
1643             evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1644           goto nosideret;
1645         }
1646       else
1647         {
1648           value_ptr retvalp = evaluate_subexp_for_address (exp, pos, noside);
1649           /* If HP aCC object, use bias for pointers to members */
1650           if (hp_som_som_object_present &&
1651               (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
1652               (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
1653             {
1654               unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (retvalp);    /* forces evaluation */
1655               *ptr |= 0x20000000;       /* set 29th bit */
1656             }
1657           return retvalp;
1658         }
1659
1660     case UNOP_SIZEOF:
1661       if (noside == EVAL_SKIP)
1662         {
1663           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1664           goto nosideret;
1665         }
1666       return evaluate_subexp_for_sizeof (exp, pos);
1667
1668     case UNOP_CAST:
1669       (*pos) += 2;
1670       type = exp->elts[pc + 1].type;
1671       arg1 = evaluate_subexp (type, exp, pos, noside);
1672       if (noside == EVAL_SKIP)
1673         goto nosideret;
1674       if (type != VALUE_TYPE (arg1))
1675         arg1 = value_cast (type, arg1);
1676       return arg1;
1677
1678     case UNOP_MEMVAL:
1679       (*pos) += 2;
1680       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1681       if (noside == EVAL_SKIP)
1682         goto nosideret;
1683       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1684         return value_zero (exp->elts[pc + 1].type, lval_memory);
1685       else
1686         return value_at_lazy (exp->elts[pc + 1].type,
1687                               value_as_pointer (arg1),
1688                               NULL);
1689
1690     case UNOP_PREINCREMENT:
1691       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1692       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1693         return arg1;
1694       else if (unop_user_defined_p (op, arg1))
1695         {
1696           return value_x_unop (arg1, op, noside);
1697         }
1698       else
1699         {
1700           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1701                                                       (LONGEST) 1));
1702           return value_assign (arg1, arg2);
1703         }
1704
1705     case UNOP_PREDECREMENT:
1706       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1707       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1708         return arg1;
1709       else if (unop_user_defined_p (op, arg1))
1710         {
1711           return value_x_unop (arg1, op, noside);
1712         }
1713       else
1714         {
1715           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1716                                                       (LONGEST) 1));
1717           return value_assign (arg1, arg2);
1718         }
1719
1720     case UNOP_POSTINCREMENT:
1721       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1722       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1723         return arg1;
1724       else if (unop_user_defined_p (op, arg1))
1725         {
1726           return value_x_unop (arg1, op, noside);
1727         }
1728       else
1729         {
1730           arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1731                                                       (LONGEST) 1));
1732           value_assign (arg1, arg2);
1733           return arg1;
1734         }
1735
1736     case UNOP_POSTDECREMENT:
1737       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1738       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1739         return arg1;
1740       else if (unop_user_defined_p (op, arg1))
1741         {
1742           return value_x_unop (arg1, op, noside);
1743         }
1744       else
1745         {
1746           arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
1747                                                       (LONGEST) 1));
1748           value_assign (arg1, arg2);
1749           return arg1;
1750         }
1751
1752     case OP_THIS:
1753       (*pos) += 1;
1754       return value_of_this (1);
1755
1756     case OP_TYPE:
1757       error ("Attempt to use a type name as an expression");
1758
1759     default:
1760       /* Removing this case and compiling with gcc -Wall reveals that
1761          a lot of cases are hitting this case.  Some of these should
1762          probably be removed from expression.h; others are legitimate
1763          expressions which are (apparently) not fully implemented.
1764
1765          If there are any cases landing here which mean a user error,
1766          then they should be separate cases, with more descriptive
1767          error messages.  */
1768
1769       error ("\
1770 GDB does not (yet) know how to evaluate that kind of expression");
1771     }
1772
1773 nosideret:
1774   return value_from_longest (builtin_type_long, (LONGEST) 1);
1775 }
1776 \f
1777 /* Evaluate a subexpression of EXP, at index *POS,
1778    and return the address of that subexpression.
1779    Advance *POS over the subexpression.
1780    If the subexpression isn't an lvalue, get an error.
1781    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
1782    then only the type of the result need be correct.  */
1783
1784 static value_ptr
1785 evaluate_subexp_for_address (exp, pos, noside)
1786      register struct expression *exp;
1787      register int *pos;
1788      enum noside noside;
1789 {
1790   enum exp_opcode op;
1791   register int pc;
1792   struct symbol *var;
1793
1794   pc = (*pos);
1795   op = exp->elts[pc].opcode;
1796
1797   switch (op)
1798     {
1799     case UNOP_IND:
1800       (*pos)++;
1801       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1802
1803     case UNOP_MEMVAL:
1804       (*pos) += 3;
1805       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
1806                          evaluate_subexp (NULL_TYPE, exp, pos, noside));
1807
1808     case OP_VAR_VALUE:
1809       var = exp->elts[pc + 2].symbol;
1810
1811       /* C++: The "address" of a reference should yield the address
1812        * of the object pointed to. Let value_addr() deal with it. */
1813       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
1814         goto default_case;
1815
1816       (*pos) += 4;
1817       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1818         {
1819           struct type *type =
1820           lookup_pointer_type (SYMBOL_TYPE (var));
1821           enum address_class sym_class = SYMBOL_CLASS (var);
1822
1823           if (sym_class == LOC_CONST
1824               || sym_class == LOC_CONST_BYTES
1825               || sym_class == LOC_REGISTER
1826               || sym_class == LOC_REGPARM)
1827             error ("Attempt to take address of register or constant.");
1828
1829           return
1830             value_zero (type, not_lval);
1831         }
1832       else
1833         return
1834           locate_var_value
1835           (var,
1836            block_innermost_frame (exp->elts[pc + 1].block));
1837
1838     default:
1839     default_case:
1840       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1841         {
1842           value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1843           if (VALUE_LVAL (x) == lval_memory)
1844             return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
1845                                not_lval);
1846           else
1847             error ("Attempt to take address of non-lval");
1848         }
1849       return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1850     }
1851 }
1852
1853 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
1854    When used in contexts where arrays will be coerced anyway, this is
1855    equivalent to `evaluate_subexp' but much faster because it avoids
1856    actually fetching array contents (perhaps obsolete now that we have
1857    VALUE_LAZY).
1858
1859    Note that we currently only do the coercion for C expressions, where
1860    arrays are zero based and the coercion is correct.  For other languages,
1861    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
1862    to decide if coercion is appropriate.
1863
1864  */
1865
1866 value_ptr
1867 evaluate_subexp_with_coercion (exp, pos, noside)
1868      register struct expression *exp;
1869      register int *pos;
1870      enum noside noside;
1871 {
1872   register enum exp_opcode op;
1873   register int pc;
1874   register value_ptr val;
1875   struct symbol *var;
1876
1877   pc = (*pos);
1878   op = exp->elts[pc].opcode;
1879
1880   switch (op)
1881     {
1882     case OP_VAR_VALUE:
1883       var = exp->elts[pc + 2].symbol;
1884       if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
1885           && CAST_IS_CONVERSION)
1886         {
1887           (*pos) += 4;
1888           val =
1889             locate_var_value
1890             (var, block_innermost_frame (exp->elts[pc + 1].block));
1891           return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
1892                              val);
1893         }
1894       /* FALLTHROUGH */
1895
1896     default:
1897       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1898     }
1899 }
1900
1901 /* Evaluate a subexpression of EXP, at index *POS,
1902    and return a value for the size of that subexpression.
1903    Advance *POS over the subexpression.  */
1904
1905 static value_ptr
1906 evaluate_subexp_for_sizeof (exp, pos)
1907      register struct expression *exp;
1908      register int *pos;
1909 {
1910   enum exp_opcode op;
1911   register int pc;
1912   struct type *type;
1913   value_ptr val;
1914
1915   pc = (*pos);
1916   op = exp->elts[pc].opcode;
1917
1918   switch (op)
1919     {
1920       /* This case is handled specially
1921          so that we avoid creating a value for the result type.
1922          If the result type is very big, it's desirable not to
1923          create a value unnecessarily.  */
1924     case UNOP_IND:
1925       (*pos)++;
1926       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1927       type = check_typedef (VALUE_TYPE (val));
1928       if (TYPE_CODE (type) != TYPE_CODE_PTR
1929           && TYPE_CODE (type) != TYPE_CODE_REF
1930           && TYPE_CODE (type) != TYPE_CODE_ARRAY)
1931         error ("Attempt to take contents of a non-pointer value.");
1932       type = check_typedef (TYPE_TARGET_TYPE (type));
1933       return value_from_longest (builtin_type_int, (LONGEST)
1934                                  TYPE_LENGTH (type));
1935
1936     case UNOP_MEMVAL:
1937       (*pos) += 3;
1938       type = check_typedef (exp->elts[pc + 1].type);
1939       return value_from_longest (builtin_type_int,
1940                                  (LONGEST) TYPE_LENGTH (type));
1941
1942     case OP_VAR_VALUE:
1943       (*pos) += 4;
1944       type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
1945       return
1946         value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
1947
1948     default:
1949       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1950       return value_from_longest (builtin_type_int,
1951                                  (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
1952     }
1953 }
1954
1955 /* Parse a type expression in the string [P..P+LENGTH). */
1956
1957 struct type *
1958 parse_and_eval_type (p, length)
1959      char *p;
1960      int length;
1961 {
1962   char *tmp = (char *) alloca (length + 4);
1963   struct expression *expr;
1964   tmp[0] = '(';
1965   memcpy (tmp + 1, p, length);
1966   tmp[length + 1] = ')';
1967   tmp[length + 2] = '0';
1968   tmp[length + 3] = '\0';
1969   expr = parse_expression (tmp);
1970   if (expr->elts[0].opcode != UNOP_CAST)
1971     error ("Internal error in eval_type.");
1972   return expr->elts[1].type;
1973 }
1974
1975 int
1976 calc_f77_array_dims (array_type)
1977      struct type *array_type;
1978 {
1979   int ndimen = 1;
1980   struct type *tmp_type;
1981
1982   if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
1983     error ("Can't get dimensions for a non-array type");
1984
1985   tmp_type = array_type;
1986
1987   while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
1988     {
1989       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
1990         ++ndimen;
1991     }
1992   return ndimen;
1993 }