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