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