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