gdb/eval.c

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