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