gdb/eval.c

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