Handle "p S::method()::static_var" in the C++ parser
[binutils-gdb.git] / gdb / eval.c
1 /* Evaluate expressions for GDB.
2
3 Copyright (C) 1986-2017 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 3 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, see <http://www.gnu.org/licenses/>. */
19
20 #include "defs.h"
21 #include "symtab.h"
22 #include "gdbtypes.h"
23 #include "value.h"
24 #include "expression.h"
25 #include "target.h"
26 #include "frame.h"
27 #include "gdbthread.h"
28 #include "language.h" /* For CAST_IS_CONVERSION. */
29 #include "f-lang.h" /* For array bound stuff. */
30 #include "cp-abi.h"
31 #include "infcall.h"
32 #include "objc-lang.h"
33 #include "block.h"
34 #include "parser-defs.h"
35 #include "cp-support.h"
36 #include "ui-out.h"
37 #include "regcache.h"
38 #include "user-regs.h"
39 #include "valprint.h"
40 #include "gdb_obstack.h"
41 #include "objfiles.h"
42 #include "typeprint.h"
43 #include <ctype.h>
44
45 /* This is defined in valops.c */
46 extern int overload_resolution;
47
48 /* Prototypes for local functions. */
49
50 static struct value *evaluate_subexp_for_sizeof (struct expression *, int *,
51 enum noside);
52
53 static struct value *evaluate_subexp_for_address (struct expression *,
54 int *, enum noside);
55
56 static value *evaluate_subexp_for_cast (expression *exp, int *pos,
57 enum noside noside,
58 struct type *type);
59
60 static struct value *evaluate_struct_tuple (struct value *,
61 struct expression *, int *,
62 enum noside, int);
63
64 static LONGEST init_array_element (struct value *, struct value *,
65 struct expression *, int *, enum noside,
66 LONGEST, LONGEST);
67
68 struct value *
69 evaluate_subexp (struct type *expect_type, struct expression *exp,
70 int *pos, enum noside noside)
71 {
72 struct cleanup *cleanups;
73 struct value *retval;
74 int cleanup_temps = 0;
75
76 if (*pos == 0 && target_has_execution
77 && exp->language_defn->la_language == language_cplus
78 && !thread_stack_temporaries_enabled_p (inferior_ptid))
79 {
80 cleanups = enable_thread_stack_temporaries (inferior_ptid);
81 cleanup_temps = 1;
82 }
83
84 retval = (*exp->language_defn->la_exp_desc->evaluate_exp)
85 (expect_type, exp, pos, noside);
86
87 if (cleanup_temps)
88 {
89 if (value_in_thread_stack_temporaries (retval, inferior_ptid))
90 retval = value_non_lval (retval);
91 do_cleanups (cleanups);
92 }
93
94 return retval;
95 }
96 \f
97 /* Parse the string EXP as a C expression, evaluate it,
98 and return the result as a number. */
99
100 CORE_ADDR
101 parse_and_eval_address (const char *exp)
102 {
103 expression_up expr = parse_expression (exp);
104
105 return value_as_address (evaluate_expression (expr.get ()));
106 }
107
108 /* Like parse_and_eval_address, but treats the value of the expression
109 as an integer, not an address, returns a LONGEST, not a CORE_ADDR. */
110 LONGEST
111 parse_and_eval_long (const char *exp)
112 {
113 expression_up expr = parse_expression (exp);
114
115 return value_as_long (evaluate_expression (expr.get ()));
116 }
117
118 struct value *
119 parse_and_eval (const char *exp)
120 {
121 expression_up expr = parse_expression (exp);
122
123 return evaluate_expression (expr.get ());
124 }
125
126 /* Parse up to a comma (or to a closeparen)
127 in the string EXPP as an expression, evaluate it, and return the value.
128 EXPP is advanced to point to the comma. */
129
130 struct value *
131 parse_to_comma_and_eval (const char **expp)
132 {
133 expression_up expr = parse_exp_1 (expp, 0, (struct block *) 0, 1);
134
135 return evaluate_expression (expr.get ());
136 }
137 \f
138 /* Evaluate an expression in internal prefix form
139 such as is constructed by parse.y.
140
141 See expression.h for info on the format of an expression. */
142
143 struct value *
144 evaluate_expression (struct expression *exp)
145 {
146 int pc = 0;
147
148 return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
149 }
150
151 /* Evaluate an expression, avoiding all memory references
152 and getting a value whose type alone is correct. */
153
154 struct value *
155 evaluate_type (struct expression *exp)
156 {
157 int pc = 0;
158
159 return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
160 }
161
162 /* Evaluate a subexpression, avoiding all memory references and
163 getting a value whose type alone is correct. */
164
165 struct value *
166 evaluate_subexpression_type (struct expression *exp, int subexp)
167 {
168 return evaluate_subexp (NULL_TYPE, exp, &subexp, EVAL_AVOID_SIDE_EFFECTS);
169 }
170
171 /* Find the current value of a watchpoint on EXP. Return the value in
172 *VALP and *RESULTP and the chain of intermediate and final values
173 in *VAL_CHAIN. RESULTP and VAL_CHAIN may be NULL if the caller does
174 not need them.
175
176 If PRESERVE_ERRORS is true, then exceptions are passed through.
177 Otherwise, if PRESERVE_ERRORS is false, then if a memory error
178 occurs while evaluating the expression, *RESULTP will be set to
179 NULL. *RESULTP may be a lazy value, if the result could not be
180 read from memory. It is used to determine whether a value is
181 user-specified (we should watch the whole value) or intermediate
182 (we should watch only the bit used to locate the final value).
183
184 If the final value, or any intermediate value, could not be read
185 from memory, *VALP will be set to NULL. *VAL_CHAIN will still be
186 set to any referenced values. *VALP will never be a lazy value.
187 This is the value which we store in struct breakpoint.
188
189 If VAL_CHAIN is non-NULL, *VAL_CHAIN will be released from the
190 value chain. The caller must free the values individually. If
191 VAL_CHAIN is NULL, all generated values will be left on the value
192 chain. */
193
194 void
195 fetch_subexp_value (struct expression *exp, int *pc, struct value **valp,
196 struct value **resultp, struct value **val_chain,
197 int preserve_errors)
198 {
199 struct value *mark, *new_mark, *result;
200
201 *valp = NULL;
202 if (resultp)
203 *resultp = NULL;
204 if (val_chain)
205 *val_chain = NULL;
206
207 /* Evaluate the expression. */
208 mark = value_mark ();
209 result = NULL;
210
211 TRY
212 {
213 result = evaluate_subexp (NULL_TYPE, exp, pc, EVAL_NORMAL);
214 }
215 CATCH (ex, RETURN_MASK_ALL)
216 {
217 /* Ignore memory errors if we want watchpoints pointing at
218 inaccessible memory to still be created; otherwise, throw the
219 error to some higher catcher. */
220 switch (ex.error)
221 {
222 case MEMORY_ERROR:
223 if (!preserve_errors)
224 break;
225 default:
226 throw_exception (ex);
227 break;
228 }
229 }
230 END_CATCH
231
232 new_mark = value_mark ();
233 if (mark == new_mark)
234 return;
235 if (resultp)
236 *resultp = result;
237
238 /* Make sure it's not lazy, so that after the target stops again we
239 have a non-lazy previous value to compare with. */
240 if (result != NULL)
241 {
242 if (!value_lazy (result))
243 *valp = result;
244 else
245 {
246
247 TRY
248 {
249 value_fetch_lazy (result);
250 *valp = result;
251 }
252 CATCH (except, RETURN_MASK_ERROR)
253 {
254 }
255 END_CATCH
256 }
257 }
258
259 if (val_chain)
260 {
261 /* Return the chain of intermediate values. We use this to
262 decide which addresses to watch. */
263 *val_chain = new_mark;
264 value_release_to_mark (mark);
265 }
266 }
267
268 /* Extract a field operation from an expression. If the subexpression
269 of EXP starting at *SUBEXP is not a structure dereference
270 operation, return NULL. Otherwise, return the name of the
271 dereferenced field, and advance *SUBEXP to point to the
272 subexpression of the left-hand-side of the dereference. This is
273 used when completing field names. */
274
275 char *
276 extract_field_op (struct expression *exp, int *subexp)
277 {
278 int tem;
279 char *result;
280
281 if (exp->elts[*subexp].opcode != STRUCTOP_STRUCT
282 && exp->elts[*subexp].opcode != STRUCTOP_PTR)
283 return NULL;
284 tem = longest_to_int (exp->elts[*subexp + 1].longconst);
285 result = &exp->elts[*subexp + 2].string;
286 (*subexp) += 1 + 3 + BYTES_TO_EXP_ELEM (tem + 1);
287 return result;
288 }
289
290 /* This function evaluates brace-initializers (in C/C++) for
291 structure types. */
292
293 static struct value *
294 evaluate_struct_tuple (struct value *struct_val,
295 struct expression *exp,
296 int *pos, enum noside noside, int nargs)
297 {
298 struct type *struct_type = check_typedef (value_type (struct_val));
299 struct type *field_type;
300 int fieldno = -1;
301
302 while (--nargs >= 0)
303 {
304 struct value *val = NULL;
305 int bitpos, bitsize;
306 bfd_byte *addr;
307
308 fieldno++;
309 /* Skip static fields. */
310 while (fieldno < TYPE_NFIELDS (struct_type)
311 && field_is_static (&TYPE_FIELD (struct_type,
312 fieldno)))
313 fieldno++;
314 if (fieldno >= TYPE_NFIELDS (struct_type))
315 error (_("too many initializers"));
316 field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
317 if (TYPE_CODE (field_type) == TYPE_CODE_UNION
318 && TYPE_FIELD_NAME (struct_type, fieldno)[0] == '0')
319 error (_("don't know which variant you want to set"));
320
321 /* Here, struct_type is the type of the inner struct,
322 while substruct_type is the type of the inner struct.
323 These are the same for normal structures, but a variant struct
324 contains anonymous union fields that contain substruct fields.
325 The value fieldno is the index of the top-level (normal or
326 anonymous union) field in struct_field, while the value
327 subfieldno is the index of the actual real (named inner) field
328 in substruct_type. */
329
330 field_type = TYPE_FIELD_TYPE (struct_type, fieldno);
331 if (val == 0)
332 val = evaluate_subexp (field_type, exp, pos, noside);
333
334 /* Now actually set the field in struct_val. */
335
336 /* Assign val to field fieldno. */
337 if (value_type (val) != field_type)
338 val = value_cast (field_type, val);
339
340 bitsize = TYPE_FIELD_BITSIZE (struct_type, fieldno);
341 bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
342 addr = value_contents_writeable (struct_val) + bitpos / 8;
343 if (bitsize)
344 modify_field (struct_type, addr,
345 value_as_long (val), bitpos % 8, bitsize);
346 else
347 memcpy (addr, value_contents (val),
348 TYPE_LENGTH (value_type (val)));
349
350 }
351 return struct_val;
352 }
353
354 /* Recursive helper function for setting elements of array tuples.
355 The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND); the
356 element value is ELEMENT; EXP, POS and NOSIDE are as usual.
357 Evaluates index expresions and sets the specified element(s) of
358 ARRAY to ELEMENT. Returns last index value. */
359
360 static LONGEST
361 init_array_element (struct value *array, struct value *element,
362 struct expression *exp, int *pos,
363 enum noside noside, LONGEST low_bound, LONGEST high_bound)
364 {
365 LONGEST index;
366 int element_size = TYPE_LENGTH (value_type (element));
367
368 if (exp->elts[*pos].opcode == BINOP_COMMA)
369 {
370 (*pos)++;
371 init_array_element (array, element, exp, pos, noside,
372 low_bound, high_bound);
373 return init_array_element (array, element,
374 exp, pos, noside, low_bound, high_bound);
375 }
376 else
377 {
378 index = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
379 if (index < low_bound || index > high_bound)
380 error (_("tuple index out of range"));
381 memcpy (value_contents_raw (array) + (index - low_bound) * element_size,
382 value_contents (element), element_size);
383 }
384 return index;
385 }
386
387 static struct value *
388 value_f90_subarray (struct value *array,
389 struct expression *exp, int *pos, enum noside noside)
390 {
391 int pc = (*pos) + 1;
392 LONGEST low_bound, high_bound;
393 struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
394 enum range_type range_type
395 = (enum range_type) longest_to_int (exp->elts[pc].longconst);
396
397 *pos += 3;
398
399 if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
400 low_bound = TYPE_LOW_BOUND (range);
401 else
402 low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
403
404 if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
405 high_bound = TYPE_HIGH_BOUND (range);
406 else
407 high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
408
409 return value_slice (array, low_bound, high_bound - low_bound + 1);
410 }
411
412
413 /* Promote value ARG1 as appropriate before performing a unary operation
414 on this argument.
415 If the result is not appropriate for any particular language then it
416 needs to patch this function. */
417
418 void
419 unop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
420 struct value **arg1)
421 {
422 struct type *type1;
423
424 *arg1 = coerce_ref (*arg1);
425 type1 = check_typedef (value_type (*arg1));
426
427 if (is_integral_type (type1))
428 {
429 switch (language->la_language)
430 {
431 default:
432 /* Perform integral promotion for ANSI C/C++.
433 If not appropropriate for any particular language
434 it needs to modify this function. */
435 {
436 struct type *builtin_int = builtin_type (gdbarch)->builtin_int;
437
438 if (TYPE_LENGTH (type1) < TYPE_LENGTH (builtin_int))
439 *arg1 = value_cast (builtin_int, *arg1);
440 }
441 break;
442 }
443 }
444 }
445
446 /* Promote values ARG1 and ARG2 as appropriate before performing a binary
447 operation on those two operands.
448 If the result is not appropriate for any particular language then it
449 needs to patch this function. */
450
451 void
452 binop_promote (const struct language_defn *language, struct gdbarch *gdbarch,
453 struct value **arg1, struct value **arg2)
454 {
455 struct type *promoted_type = NULL;
456 struct type *type1;
457 struct type *type2;
458
459 *arg1 = coerce_ref (*arg1);
460 *arg2 = coerce_ref (*arg2);
461
462 type1 = check_typedef (value_type (*arg1));
463 type2 = check_typedef (value_type (*arg2));
464
465 if ((TYPE_CODE (type1) != TYPE_CODE_FLT
466 && TYPE_CODE (type1) != TYPE_CODE_DECFLOAT
467 && !is_integral_type (type1))
468 || (TYPE_CODE (type2) != TYPE_CODE_FLT
469 && TYPE_CODE (type2) != TYPE_CODE_DECFLOAT
470 && !is_integral_type (type2)))
471 return;
472
473 if (TYPE_CODE (type1) == TYPE_CODE_DECFLOAT
474 || TYPE_CODE (type2) == TYPE_CODE_DECFLOAT)
475 {
476 /* No promotion required. */
477 }
478 else if (TYPE_CODE (type1) == TYPE_CODE_FLT
479 || TYPE_CODE (type2) == TYPE_CODE_FLT)
480 {
481 switch (language->la_language)
482 {
483 case language_c:
484 case language_cplus:
485 case language_asm:
486 case language_objc:
487 case language_opencl:
488 /* No promotion required. */
489 break;
490
491 default:
492 /* For other languages the result type is unchanged from gdb
493 version 6.7 for backward compatibility.
494 If either arg was long double, make sure that value is also long
495 double. Otherwise use double. */
496 if (TYPE_LENGTH (type1) * 8 > gdbarch_double_bit (gdbarch)
497 || TYPE_LENGTH (type2) * 8 > gdbarch_double_bit (gdbarch))
498 promoted_type = builtin_type (gdbarch)->builtin_long_double;
499 else
500 promoted_type = builtin_type (gdbarch)->builtin_double;
501 break;
502 }
503 }
504 else if (TYPE_CODE (type1) == TYPE_CODE_BOOL
505 && TYPE_CODE (type2) == TYPE_CODE_BOOL)
506 {
507 /* No promotion required. */
508 }
509 else
510 /* Integral operations here. */
511 /* FIXME: Also mixed integral/booleans, with result an integer. */
512 {
513 const struct builtin_type *builtin = builtin_type (gdbarch);
514 unsigned int promoted_len1 = TYPE_LENGTH (type1);
515 unsigned int promoted_len2 = TYPE_LENGTH (type2);
516 int is_unsigned1 = TYPE_UNSIGNED (type1);
517 int is_unsigned2 = TYPE_UNSIGNED (type2);
518 unsigned int result_len;
519 int unsigned_operation;
520
521 /* Determine type length and signedness after promotion for
522 both operands. */
523 if (promoted_len1 < TYPE_LENGTH (builtin->builtin_int))
524 {
525 is_unsigned1 = 0;
526 promoted_len1 = TYPE_LENGTH (builtin->builtin_int);
527 }
528 if (promoted_len2 < TYPE_LENGTH (builtin->builtin_int))
529 {
530 is_unsigned2 = 0;
531 promoted_len2 = TYPE_LENGTH (builtin->builtin_int);
532 }
533
534 if (promoted_len1 > promoted_len2)
535 {
536 unsigned_operation = is_unsigned1;
537 result_len = promoted_len1;
538 }
539 else if (promoted_len2 > promoted_len1)
540 {
541 unsigned_operation = is_unsigned2;
542 result_len = promoted_len2;
543 }
544 else
545 {
546 unsigned_operation = is_unsigned1 || is_unsigned2;
547 result_len = promoted_len1;
548 }
549
550 switch (language->la_language)
551 {
552 case language_c:
553 case language_cplus:
554 case language_asm:
555 case language_objc:
556 if (result_len <= TYPE_LENGTH (builtin->builtin_int))
557 {
558 promoted_type = (unsigned_operation
559 ? builtin->builtin_unsigned_int
560 : builtin->builtin_int);
561 }
562 else if (result_len <= TYPE_LENGTH (builtin->builtin_long))
563 {
564 promoted_type = (unsigned_operation
565 ? builtin->builtin_unsigned_long
566 : builtin->builtin_long);
567 }
568 else
569 {
570 promoted_type = (unsigned_operation
571 ? builtin->builtin_unsigned_long_long
572 : builtin->builtin_long_long);
573 }
574 break;
575 case language_opencl:
576 if (result_len <= TYPE_LENGTH (lookup_signed_typename
577 (language, gdbarch, "int")))
578 {
579 promoted_type =
580 (unsigned_operation
581 ? lookup_unsigned_typename (language, gdbarch, "int")
582 : lookup_signed_typename (language, gdbarch, "int"));
583 }
584 else if (result_len <= TYPE_LENGTH (lookup_signed_typename
585 (language, gdbarch, "long")))
586 {
587 promoted_type =
588 (unsigned_operation
589 ? lookup_unsigned_typename (language, gdbarch, "long")
590 : lookup_signed_typename (language, gdbarch,"long"));
591 }
592 break;
593 default:
594 /* For other languages the result type is unchanged from gdb
595 version 6.7 for backward compatibility.
596 If either arg was long long, make sure that value is also long
597 long. Otherwise use long. */
598 if (unsigned_operation)
599 {
600 if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
601 promoted_type = builtin->builtin_unsigned_long_long;
602 else
603 promoted_type = builtin->builtin_unsigned_long;
604 }
605 else
606 {
607 if (result_len > gdbarch_long_bit (gdbarch) / HOST_CHAR_BIT)
608 promoted_type = builtin->builtin_long_long;
609 else
610 promoted_type = builtin->builtin_long;
611 }
612 break;
613 }
614 }
615
616 if (promoted_type)
617 {
618 /* Promote both operands to common type. */
619 *arg1 = value_cast (promoted_type, *arg1);
620 *arg2 = value_cast (promoted_type, *arg2);
621 }
622 }
623
624 static int
625 ptrmath_type_p (const struct language_defn *lang, struct type *type)
626 {
627 type = check_typedef (type);
628 if (TYPE_IS_REFERENCE (type))
629 type = TYPE_TARGET_TYPE (type);
630
631 switch (TYPE_CODE (type))
632 {
633 case TYPE_CODE_PTR:
634 case TYPE_CODE_FUNC:
635 return 1;
636
637 case TYPE_CODE_ARRAY:
638 return TYPE_VECTOR (type) ? 0 : lang->c_style_arrays;
639
640 default:
641 return 0;
642 }
643 }
644
645 /* Constructs a fake method with the given parameter types.
646 This function is used by the parser to construct an "expected"
647 type for method overload resolution. */
648
649 static struct type *
650 make_params (int num_types, struct type **param_types)
651 {
652 struct type *type = XCNEW (struct type);
653 TYPE_MAIN_TYPE (type) = XCNEW (struct main_type);
654 TYPE_LENGTH (type) = 1;
655 TYPE_CODE (type) = TYPE_CODE_METHOD;
656 TYPE_CHAIN (type) = type;
657 if (num_types > 0)
658 {
659 if (param_types[num_types - 1] == NULL)
660 {
661 --num_types;
662 TYPE_VARARGS (type) = 1;
663 }
664 else if (TYPE_CODE (check_typedef (param_types[num_types - 1]))
665 == TYPE_CODE_VOID)
666 {
667 --num_types;
668 /* Caller should have ensured this. */
669 gdb_assert (num_types == 0);
670 TYPE_PROTOTYPED (type) = 1;
671 }
672 }
673
674 TYPE_NFIELDS (type) = num_types;
675 TYPE_FIELDS (type) = (struct field *)
676 TYPE_ZALLOC (type, sizeof (struct field) * num_types);
677
678 while (num_types-- > 0)
679 TYPE_FIELD_TYPE (type, num_types) = param_types[num_types];
680
681 return type;
682 }
683
684 /* Helper for evaluating an OP_VAR_VALUE. */
685
686 static value *
687 evaluate_var_value (enum noside noside, const block *blk, symbol *var)
688 {
689 /* JYG: We used to just return value_zero of the symbol type if
690 we're asked to avoid side effects. Otherwise we return
691 value_of_variable (...). However I'm not sure if
692 value_of_variable () has any side effect. We need a full value
693 object returned here for whatis_exp () to call evaluate_type ()
694 and then pass the full value to value_rtti_target_type () if we
695 are dealing with a pointer or reference to a base class and print
696 object is on. */
697
698 struct value *ret = NULL;
699
700 TRY
701 {
702 ret = value_of_variable (var, blk);
703 }
704
705 CATCH (except, RETURN_MASK_ERROR)
706 {
707 if (noside != EVAL_AVOID_SIDE_EFFECTS)
708 throw_exception (except);
709
710 ret = value_zero (SYMBOL_TYPE (var), not_lval);
711 }
712 END_CATCH
713
714 return ret;
715 }
716
717 /* Helper for evaluating an OP_VAR_MSYM_VALUE. */
718
719 static value *
720 evaluate_var_msym_value (enum noside noside,
721 struct objfile *objfile, minimal_symbol *msymbol)
722 {
723 if (noside == EVAL_AVOID_SIDE_EFFECTS)
724 {
725 type *the_type = find_minsym_type_and_address (msymbol, objfile, NULL);
726 return value_zero (the_type, not_lval);
727 }
728 else
729 {
730 CORE_ADDR address;
731 type *the_type = find_minsym_type_and_address (msymbol, objfile, &address);
732 return value_at_lazy (the_type, address);
733 }
734 }
735
736 /* Helper for returning a value when handling EVAL_SKIP. */
737
738 static value *
739 eval_skip_value (expression *exp)
740 {
741 return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
742 }
743
744 struct value *
745 evaluate_subexp_standard (struct type *expect_type,
746 struct expression *exp, int *pos,
747 enum noside noside)
748 {
749 enum exp_opcode op;
750 int tem, tem2, tem3;
751 int pc, pc2 = 0, oldpos;
752 struct value *arg1 = NULL;
753 struct value *arg2 = NULL;
754 struct value *arg3;
755 struct type *type;
756 int nargs;
757 struct value **argvec;
758 int code;
759 int ix;
760 long mem_offset;
761 struct type **arg_types;
762 int save_pos1;
763 struct symbol *function = NULL;
764 char *function_name = NULL;
765 const char *var_func_name = NULL;
766
767 pc = (*pos)++;
768 op = exp->elts[pc].opcode;
769
770 switch (op)
771 {
772 case OP_SCOPE:
773 tem = longest_to_int (exp->elts[pc + 2].longconst);
774 (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
775 if (noside == EVAL_SKIP)
776 return eval_skip_value (exp);
777 arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
778 &exp->elts[pc + 3].string,
779 expect_type, 0, noside);
780 if (arg1 == NULL)
781 error (_("There is no field named %s"), &exp->elts[pc + 3].string);
782 return arg1;
783
784 case OP_LONG:
785 (*pos) += 3;
786 return value_from_longest (exp->elts[pc + 1].type,
787 exp->elts[pc + 2].longconst);
788
789 case OP_DOUBLE:
790 (*pos) += 3;
791 return value_from_double (exp->elts[pc + 1].type,
792 exp->elts[pc + 2].doubleconst);
793
794 case OP_DECFLOAT:
795 (*pos) += 3;
796 return value_from_decfloat (exp->elts[pc + 1].type,
797 exp->elts[pc + 2].decfloatconst);
798
799 case OP_ADL_FUNC:
800 case OP_VAR_VALUE:
801 (*pos) += 3;
802 if (noside == EVAL_SKIP)
803 return eval_skip_value (exp);
804
805 {
806 symbol *var = exp->elts[pc + 2].symbol;
807 if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ERROR)
808 error_unknown_type (SYMBOL_PRINT_NAME (var));
809
810 return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
811 }
812
813 case OP_VAR_MSYM_VALUE:
814 {
815 (*pos) += 3;
816
817 minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
818 value *val = evaluate_var_msym_value (noside,
819 exp->elts[pc + 1].objfile,
820 msymbol);
821
822 type = value_type (val);
823 if (TYPE_CODE (type) == TYPE_CODE_ERROR
824 && (noside != EVAL_AVOID_SIDE_EFFECTS || pc != 0))
825 error_unknown_type (MSYMBOL_PRINT_NAME (msymbol));
826 return val;
827 }
828
829 case OP_VAR_ENTRY_VALUE:
830 (*pos) += 2;
831 if (noside == EVAL_SKIP)
832 return eval_skip_value (exp);
833
834 {
835 struct symbol *sym = exp->elts[pc + 1].symbol;
836 struct frame_info *frame;
837
838 if (noside == EVAL_AVOID_SIDE_EFFECTS)
839 return value_zero (SYMBOL_TYPE (sym), not_lval);
840
841 if (SYMBOL_COMPUTED_OPS (sym) == NULL
842 || SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry == NULL)
843 error (_("Symbol \"%s\" does not have any specific entry value"),
844 SYMBOL_PRINT_NAME (sym));
845
846 frame = get_selected_frame (NULL);
847 return SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry (sym, frame);
848 }
849
850 case OP_FUNC_STATIC_VAR:
851 tem = longest_to_int (exp->elts[pc + 1].longconst);
852 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
853 if (noside == EVAL_SKIP)
854 return eval_skip_value (exp);
855
856 {
857 value *func = evaluate_subexp_standard (NULL, exp, pos, noside);
858 CORE_ADDR addr = value_address (func);
859
860 const block *blk = block_for_pc (addr);
861 const char *var = &exp->elts[pc + 2].string;
862
863 struct block_symbol sym = lookup_symbol (var, blk, VAR_DOMAIN, NULL);
864
865 if (sym.symbol == NULL)
866 error (_("No symbol \"%s\" in specified context."), var);
867
868 return evaluate_var_value (noside, sym.block, sym.symbol);
869 }
870
871 case OP_LAST:
872 (*pos) += 2;
873 return
874 access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
875
876 case OP_REGISTER:
877 {
878 const char *name = &exp->elts[pc + 2].string;
879 int regno;
880 struct value *val;
881
882 (*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
883 regno = user_reg_map_name_to_regnum (exp->gdbarch,
884 name, strlen (name));
885 if (regno == -1)
886 error (_("Register $%s not available."), name);
887
888 /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
889 a value with the appropriate register type. Unfortunately,
890 we don't have easy access to the type of user registers.
891 So for these registers, we fetch the register value regardless
892 of the evaluation mode. */
893 if (noside == EVAL_AVOID_SIDE_EFFECTS
894 && regno < gdbarch_num_regs (exp->gdbarch)
895 + gdbarch_num_pseudo_regs (exp->gdbarch))
896 val = value_zero (register_type (exp->gdbarch, regno), not_lval);
897 else
898 val = value_of_register (regno, get_selected_frame (NULL));
899 if (val == NULL)
900 error (_("Value of register %s not available."), name);
901 else
902 return val;
903 }
904 case OP_BOOL:
905 (*pos) += 2;
906 type = language_bool_type (exp->language_defn, exp->gdbarch);
907 return value_from_longest (type, exp->elts[pc + 1].longconst);
908
909 case OP_INTERNALVAR:
910 (*pos) += 2;
911 return value_of_internalvar (exp->gdbarch,
912 exp->elts[pc + 1].internalvar);
913
914 case OP_STRING:
915 tem = longest_to_int (exp->elts[pc + 1].longconst);
916 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
917 if (noside == EVAL_SKIP)
918 return eval_skip_value (exp);
919 type = language_string_char_type (exp->language_defn, exp->gdbarch);
920 return value_string (&exp->elts[pc + 2].string, tem, type);
921
922 case OP_OBJC_NSSTRING: /* Objective C Foundation Class
923 NSString constant. */
924 tem = longest_to_int (exp->elts[pc + 1].longconst);
925 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
926 if (noside == EVAL_SKIP)
927 return eval_skip_value (exp);
928 return value_nsstring (exp->gdbarch, &exp->elts[pc + 2].string, tem + 1);
929
930 case OP_ARRAY:
931 (*pos) += 3;
932 tem2 = longest_to_int (exp->elts[pc + 1].longconst);
933 tem3 = longest_to_int (exp->elts[pc + 2].longconst);
934 nargs = tem3 - tem2 + 1;
935 type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
936
937 if (expect_type != NULL_TYPE && noside != EVAL_SKIP
938 && TYPE_CODE (type) == TYPE_CODE_STRUCT)
939 {
940 struct value *rec = allocate_value (expect_type);
941
942 memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
943 return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
944 }
945
946 if (expect_type != NULL_TYPE && noside != EVAL_SKIP
947 && TYPE_CODE (type) == TYPE_CODE_ARRAY)
948 {
949 struct type *range_type = TYPE_INDEX_TYPE (type);
950 struct type *element_type = TYPE_TARGET_TYPE (type);
951 struct value *array = allocate_value (expect_type);
952 int element_size = TYPE_LENGTH (check_typedef (element_type));
953 LONGEST low_bound, high_bound, index;
954
955 if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
956 {
957 low_bound = 0;
958 high_bound = (TYPE_LENGTH (type) / element_size) - 1;
959 }
960 index = low_bound;
961 memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
962 for (tem = nargs; --nargs >= 0;)
963 {
964 struct value *element;
965 int index_pc = 0;
966
967 element = evaluate_subexp (element_type, exp, pos, noside);
968 if (value_type (element) != element_type)
969 element = value_cast (element_type, element);
970 if (index_pc)
971 {
972 int continue_pc = *pos;
973
974 *pos = index_pc;
975 index = init_array_element (array, element, exp, pos, noside,
976 low_bound, high_bound);
977 *pos = continue_pc;
978 }
979 else
980 {
981 if (index > high_bound)
982 /* To avoid memory corruption. */
983 error (_("Too many array elements"));
984 memcpy (value_contents_raw (array)
985 + (index - low_bound) * element_size,
986 value_contents (element),
987 element_size);
988 }
989 index++;
990 }
991 return array;
992 }
993
994 if (expect_type != NULL_TYPE && noside != EVAL_SKIP
995 && TYPE_CODE (type) == TYPE_CODE_SET)
996 {
997 struct value *set = allocate_value (expect_type);
998 gdb_byte *valaddr = value_contents_raw (set);
999 struct type *element_type = TYPE_INDEX_TYPE (type);
1000 struct type *check_type = element_type;
1001 LONGEST low_bound, high_bound;
1002
1003 /* Get targettype of elementtype. */
1004 while (TYPE_CODE (check_type) == TYPE_CODE_RANGE
1005 || TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
1006 check_type = TYPE_TARGET_TYPE (check_type);
1007
1008 if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
1009 error (_("(power)set type with unknown size"));
1010 memset (valaddr, '\0', TYPE_LENGTH (type));
1011 for (tem = 0; tem < nargs; tem++)
1012 {
1013 LONGEST range_low, range_high;
1014 struct type *range_low_type, *range_high_type;
1015 struct value *elem_val;
1016
1017 elem_val = evaluate_subexp (element_type, exp, pos, noside);
1018 range_low_type = range_high_type = value_type (elem_val);
1019 range_low = range_high = value_as_long (elem_val);
1020
1021 /* Check types of elements to avoid mixture of elements from
1022 different types. Also check if type of element is "compatible"
1023 with element type of powerset. */
1024 if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
1025 range_low_type = TYPE_TARGET_TYPE (range_low_type);
1026 if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
1027 range_high_type = TYPE_TARGET_TYPE (range_high_type);
1028 if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type))
1029 || (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM
1030 && (range_low_type != range_high_type)))
1031 /* different element modes. */
1032 error (_("POWERSET tuple elements of different mode"));
1033 if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type))
1034 || (TYPE_CODE (check_type) == TYPE_CODE_ENUM
1035 && range_low_type != check_type))
1036 error (_("incompatible POWERSET tuple elements"));
1037 if (range_low > range_high)
1038 {
1039 warning (_("empty POWERSET tuple range"));
1040 continue;
1041 }
1042 if (range_low < low_bound || range_high > high_bound)
1043 error (_("POWERSET tuple element out of range"));
1044 range_low -= low_bound;
1045 range_high -= low_bound;
1046 for (; range_low <= range_high; range_low++)
1047 {
1048 int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
1049
1050 if (gdbarch_bits_big_endian (exp->gdbarch))
1051 bit_index = TARGET_CHAR_BIT - 1 - bit_index;
1052 valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
1053 |= 1 << bit_index;
1054 }
1055 }
1056 return set;
1057 }
1058
1059 argvec = XALLOCAVEC (struct value *, nargs);
1060 for (tem = 0; tem < nargs; tem++)
1061 {
1062 /* Ensure that array expressions are coerced into pointer
1063 objects. */
1064 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1065 }
1066 if (noside == EVAL_SKIP)
1067 return eval_skip_value (exp);
1068 return value_array (tem2, tem3, argvec);
1069
1070 case TERNOP_SLICE:
1071 {
1072 struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1073 int lowbound
1074 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1075 int upper
1076 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1077
1078 if (noside == EVAL_SKIP)
1079 return eval_skip_value (exp);
1080 return value_slice (array, lowbound, upper - lowbound + 1);
1081 }
1082
1083 case TERNOP_COND:
1084 /* Skip third and second args to evaluate the first one. */
1085 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1086 if (value_logical_not (arg1))
1087 {
1088 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1089 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1090 }
1091 else
1092 {
1093 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1094 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1095 return arg2;
1096 }
1097
1098 case OP_OBJC_SELECTOR:
1099 { /* Objective C @selector operator. */
1100 char *sel = &exp->elts[pc + 2].string;
1101 int len = longest_to_int (exp->elts[pc + 1].longconst);
1102 struct type *selector_type;
1103
1104 (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1105 if (noside == EVAL_SKIP)
1106 return eval_skip_value (exp);
1107
1108 if (sel[len] != 0)
1109 sel[len] = 0; /* Make sure it's terminated. */
1110
1111 selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1112 return value_from_longest (selector_type,
1113 lookup_child_selector (exp->gdbarch, sel));
1114 }
1115
1116 case OP_OBJC_MSGCALL:
1117 { /* Objective C message (method) call. */
1118
1119 CORE_ADDR responds_selector = 0;
1120 CORE_ADDR method_selector = 0;
1121
1122 CORE_ADDR selector = 0;
1123
1124 int struct_return = 0;
1125 enum noside sub_no_side = EVAL_NORMAL;
1126
1127 struct value *msg_send = NULL;
1128 struct value *msg_send_stret = NULL;
1129 int gnu_runtime = 0;
1130
1131 struct value *target = NULL;
1132 struct value *method = NULL;
1133 struct value *called_method = NULL;
1134
1135 struct type *selector_type = NULL;
1136 struct type *long_type;
1137
1138 struct value *ret = NULL;
1139 CORE_ADDR addr = 0;
1140
1141 selector = exp->elts[pc + 1].longconst;
1142 nargs = exp->elts[pc + 2].longconst;
1143 argvec = XALLOCAVEC (struct value *, nargs + 5);
1144
1145 (*pos) += 3;
1146
1147 long_type = builtin_type (exp->gdbarch)->builtin_long;
1148 selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1149
1150 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1151 sub_no_side = EVAL_NORMAL;
1152 else
1153 sub_no_side = noside;
1154
1155 target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1156
1157 if (value_as_long (target) == 0)
1158 return value_from_longest (long_type, 0);
1159
1160 if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0).minsym)
1161 gnu_runtime = 1;
1162
1163 /* Find the method dispatch (Apple runtime) or method lookup
1164 (GNU runtime) function for Objective-C. These will be used
1165 to lookup the symbol information for the method. If we
1166 can't find any symbol information, then we'll use these to
1167 call the method, otherwise we can call the method
1168 directly. The msg_send_stret function is used in the special
1169 case of a method that returns a structure (Apple runtime
1170 only). */
1171 if (gnu_runtime)
1172 {
1173 struct type *type = selector_type;
1174
1175 type = lookup_function_type (type);
1176 type = lookup_pointer_type (type);
1177 type = lookup_function_type (type);
1178 type = lookup_pointer_type (type);
1179
1180 msg_send = find_function_in_inferior ("objc_msg_lookup", NULL);
1181 msg_send_stret
1182 = find_function_in_inferior ("objc_msg_lookup", NULL);
1183
1184 msg_send = value_from_pointer (type, value_as_address (msg_send));
1185 msg_send_stret = value_from_pointer (type,
1186 value_as_address (msg_send_stret));
1187 }
1188 else
1189 {
1190 msg_send = find_function_in_inferior ("objc_msgSend", NULL);
1191 /* Special dispatcher for methods returning structs. */
1192 msg_send_stret
1193 = find_function_in_inferior ("objc_msgSend_stret", NULL);
1194 }
1195
1196 /* Verify the target object responds to this method. The
1197 standard top-level 'Object' class uses a different name for
1198 the verification method than the non-standard, but more
1199 often used, 'NSObject' class. Make sure we check for both. */
1200
1201 responds_selector
1202 = lookup_child_selector (exp->gdbarch, "respondsToSelector:");
1203 if (responds_selector == 0)
1204 responds_selector
1205 = lookup_child_selector (exp->gdbarch, "respondsTo:");
1206
1207 if (responds_selector == 0)
1208 error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
1209
1210 method_selector
1211 = lookup_child_selector (exp->gdbarch, "methodForSelector:");
1212 if (method_selector == 0)
1213 method_selector
1214 = lookup_child_selector (exp->gdbarch, "methodFor:");
1215
1216 if (method_selector == 0)
1217 error (_("no 'methodFor:' or 'methodForSelector:' method"));
1218
1219 /* Call the verification method, to make sure that the target
1220 class implements the desired method. */
1221
1222 argvec[0] = msg_send;
1223 argvec[1] = target;
1224 argvec[2] = value_from_longest (long_type, responds_selector);
1225 argvec[3] = value_from_longest (long_type, selector);
1226 argvec[4] = 0;
1227
1228 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
1229 if (gnu_runtime)
1230 {
1231 /* Function objc_msg_lookup returns a pointer. */
1232 argvec[0] = ret;
1233 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
1234 }
1235 if (value_as_long (ret) == 0)
1236 error (_("Target does not respond to this message selector."));
1237
1238 /* Call "methodForSelector:" method, to get the address of a
1239 function method that implements this selector for this
1240 class. If we can find a symbol at that address, then we
1241 know the return type, parameter types etc. (that's a good
1242 thing). */
1243
1244 argvec[0] = msg_send;
1245 argvec[1] = target;
1246 argvec[2] = value_from_longest (long_type, method_selector);
1247 argvec[3] = value_from_longest (long_type, selector);
1248 argvec[4] = 0;
1249
1250 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
1251 if (gnu_runtime)
1252 {
1253 argvec[0] = ret;
1254 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
1255 }
1256
1257 /* ret should now be the selector. */
1258
1259 addr = value_as_long (ret);
1260 if (addr)
1261 {
1262 struct symbol *sym = NULL;
1263
1264 /* The address might point to a function descriptor;
1265 resolve it to the actual code address instead. */
1266 addr = gdbarch_convert_from_func_ptr_addr (exp->gdbarch, addr,
1267 &current_target);
1268
1269 /* Is it a high_level symbol? */
1270 sym = find_pc_function (addr);
1271 if (sym != NULL)
1272 method = value_of_variable (sym, 0);
1273 }
1274
1275 /* If we found a method with symbol information, check to see
1276 if it returns a struct. Otherwise assume it doesn't. */
1277
1278 if (method)
1279 {
1280 CORE_ADDR funaddr;
1281 struct type *val_type;
1282
1283 funaddr = find_function_addr (method, &val_type);
1284
1285 block_for_pc (funaddr);
1286
1287 val_type = check_typedef (val_type);
1288
1289 if ((val_type == NULL)
1290 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
1291 {
1292 if (expect_type != NULL)
1293 val_type = expect_type;
1294 }
1295
1296 struct_return = using_struct_return (exp->gdbarch, method,
1297 val_type);
1298 }
1299 else if (expect_type != NULL)
1300 {
1301 struct_return = using_struct_return (exp->gdbarch, NULL,
1302 check_typedef (expect_type));
1303 }
1304
1305 /* Found a function symbol. Now we will substitute its
1306 value in place of the message dispatcher (obj_msgSend),
1307 so that we call the method directly instead of thru
1308 the dispatcher. The main reason for doing this is that
1309 we can now evaluate the return value and parameter values
1310 according to their known data types, in case we need to
1311 do things like promotion, dereferencing, special handling
1312 of structs and doubles, etc.
1313
1314 We want to use the type signature of 'method', but still
1315 jump to objc_msgSend() or objc_msgSend_stret() to better
1316 mimic the behavior of the runtime. */
1317
1318 if (method)
1319 {
1320 if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
1321 error (_("method address has symbol information "
1322 "with non-function type; skipping"));
1323
1324 /* Create a function pointer of the appropriate type, and
1325 replace its value with the value of msg_send or
1326 msg_send_stret. We must use a pointer here, as
1327 msg_send and msg_send_stret are of pointer type, and
1328 the representation may be different on systems that use
1329 function descriptors. */
1330 if (struct_return)
1331 called_method
1332 = value_from_pointer (lookup_pointer_type (value_type (method)),
1333 value_as_address (msg_send_stret));
1334 else
1335 called_method
1336 = value_from_pointer (lookup_pointer_type (value_type (method)),
1337 value_as_address (msg_send));
1338 }
1339 else
1340 {
1341 if (struct_return)
1342 called_method = msg_send_stret;
1343 else
1344 called_method = msg_send;
1345 }
1346
1347 if (noside == EVAL_SKIP)
1348 return eval_skip_value (exp);
1349
1350 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1351 {
1352 /* If the return type doesn't look like a function type,
1353 call an error. This can happen if somebody tries to
1354 turn a variable into a function call. This is here
1355 because people often want to call, eg, strcmp, which
1356 gdb doesn't know is a function. If gdb isn't asked for
1357 it's opinion (ie. through "whatis"), it won't offer
1358 it. */
1359
1360 struct type *type = value_type (called_method);
1361
1362 if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1363 type = TYPE_TARGET_TYPE (type);
1364 type = TYPE_TARGET_TYPE (type);
1365
1366 if (type)
1367 {
1368 if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1369 return allocate_value (expect_type);
1370 else
1371 return allocate_value (type);
1372 }
1373 else
1374 error (_("Expression of type other than "
1375 "\"method returning ...\" used as a method"));
1376 }
1377
1378 /* Now depending on whether we found a symbol for the method,
1379 we will either call the runtime dispatcher or the method
1380 directly. */
1381
1382 argvec[0] = called_method;
1383 argvec[1] = target;
1384 argvec[2] = value_from_longest (long_type, selector);
1385 /* User-supplied arguments. */
1386 for (tem = 0; tem < nargs; tem++)
1387 argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1388 argvec[tem + 3] = 0;
1389
1390 if (gnu_runtime && (method != NULL))
1391 {
1392 /* Function objc_msg_lookup returns a pointer. */
1393 deprecated_set_value_type (argvec[0],
1394 lookup_pointer_type (lookup_function_type (value_type (argvec[0]))));
1395 argvec[0]
1396 = call_function_by_hand (argvec[0], NULL, nargs + 2, argvec + 1);
1397 }
1398
1399 ret = call_function_by_hand (argvec[0], NULL, nargs + 2, argvec + 1);
1400 return ret;
1401 }
1402 break;
1403
1404 case OP_FUNCALL:
1405 (*pos) += 2;
1406 op = exp->elts[*pos].opcode;
1407 nargs = longest_to_int (exp->elts[pc + 1].longconst);
1408 /* Allocate arg vector, including space for the function to be
1409 called in argvec[0], a potential `this', and a terminating NULL. */
1410 argvec = (struct value **)
1411 alloca (sizeof (struct value *) * (nargs + 3));
1412 if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1413 {
1414 /* First, evaluate the structure into arg2. */
1415 pc2 = (*pos)++;
1416
1417 if (op == STRUCTOP_MEMBER)
1418 {
1419 arg2 = evaluate_subexp_for_address (exp, pos, noside);
1420 }
1421 else
1422 {
1423 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1424 }
1425
1426 /* If the function is a virtual function, then the
1427 aggregate value (providing the structure) plays
1428 its part by providing the vtable. Otherwise,
1429 it is just along for the ride: call the function
1430 directly. */
1431
1432 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1433
1434 type = check_typedef (value_type (arg1));
1435 if (noside == EVAL_SKIP)
1436 tem = 1; /* Set it to the right arg index so that all arguments
1437 can also be skipped. */
1438 else if (TYPE_CODE (type) == TYPE_CODE_METHODPTR)
1439 {
1440 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1441 arg1 = value_zero (TYPE_TARGET_TYPE (type), not_lval);
1442 else
1443 arg1 = cplus_method_ptr_to_value (&arg2, arg1);
1444
1445 /* Now, say which argument to start evaluating from. */
1446 nargs++;
1447 tem = 2;
1448 argvec[1] = arg2;
1449 }
1450 else if (TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
1451 {
1452 struct type *type_ptr
1453 = lookup_pointer_type (TYPE_SELF_TYPE (type));
1454 struct type *target_type_ptr
1455 = lookup_pointer_type (TYPE_TARGET_TYPE (type));
1456
1457 /* Now, convert these values to an address. */
1458 arg2 = value_cast (type_ptr, arg2);
1459
1460 mem_offset = value_as_long (arg1);
1461
1462 arg1 = value_from_pointer (target_type_ptr,
1463 value_as_long (arg2) + mem_offset);
1464 arg1 = value_ind (arg1);
1465 tem = 1;
1466 }
1467 else
1468 error (_("Non-pointer-to-member value used in pointer-to-member "
1469 "construct"));
1470 }
1471 else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
1472 {
1473 /* Hair for method invocations. */
1474 int tem2;
1475
1476 nargs++;
1477 /* First, evaluate the structure into arg2. */
1478 pc2 = (*pos)++;
1479 tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
1480 *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
1481
1482 if (op == STRUCTOP_STRUCT)
1483 {
1484 /* If v is a variable in a register, and the user types
1485 v.method (), this will produce an error, because v has
1486 no address.
1487
1488 A possible way around this would be to allocate a
1489 copy of the variable on the stack, copy in the
1490 contents, call the function, and copy out the
1491 contents. I.e. convert this from call by reference
1492 to call by copy-return (or whatever it's called).
1493 However, this does not work because it is not the
1494 same: the method being called could stash a copy of
1495 the address, and then future uses through that address
1496 (after the method returns) would be expected to
1497 use the variable itself, not some copy of it. */
1498 arg2 = evaluate_subexp_for_address (exp, pos, noside);
1499 }
1500 else
1501 {
1502 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1503
1504 /* Check to see if the operator '->' has been
1505 overloaded. If the operator has been overloaded
1506 replace arg2 with the value returned by the custom
1507 operator and continue evaluation. */
1508 while (unop_user_defined_p (op, arg2))
1509 {
1510 struct value *value = NULL;
1511 TRY
1512 {
1513 value = value_x_unop (arg2, op, noside);
1514 }
1515
1516 CATCH (except, RETURN_MASK_ERROR)
1517 {
1518 if (except.error == NOT_FOUND_ERROR)
1519 break;
1520 else
1521 throw_exception (except);
1522 }
1523 END_CATCH
1524
1525 arg2 = value;
1526 }
1527 }
1528 /* Now, say which argument to start evaluating from. */
1529 tem = 2;
1530 }
1531 else if (op == OP_SCOPE
1532 && overload_resolution
1533 && (exp->language_defn->la_language == language_cplus))
1534 {
1535 /* Unpack it locally so we can properly handle overload
1536 resolution. */
1537 char *name;
1538 int local_tem;
1539
1540 pc2 = (*pos)++;
1541 local_tem = longest_to_int (exp->elts[pc2 + 2].longconst);
1542 (*pos) += 4 + BYTES_TO_EXP_ELEM (local_tem + 1);
1543 type = exp->elts[pc2 + 1].type;
1544 name = &exp->elts[pc2 + 3].string;
1545
1546 function = NULL;
1547 function_name = NULL;
1548 if (TYPE_CODE (type) == TYPE_CODE_NAMESPACE)
1549 {
1550 function = cp_lookup_symbol_namespace (TYPE_TAG_NAME (type),
1551 name,
1552 get_selected_block (0),
1553 VAR_DOMAIN).symbol;
1554 if (function == NULL)
1555 error (_("No symbol \"%s\" in namespace \"%s\"."),
1556 name, TYPE_TAG_NAME (type));
1557
1558 tem = 1;
1559 /* arg2 is left as NULL on purpose. */
1560 }
1561 else
1562 {
1563 gdb_assert (TYPE_CODE (type) == TYPE_CODE_STRUCT
1564 || TYPE_CODE (type) == TYPE_CODE_UNION);
1565 function_name = name;
1566
1567 /* We need a properly typed value for method lookup. For
1568 static methods arg2 is otherwise unused. */
1569 arg2 = value_zero (type, lval_memory);
1570 ++nargs;
1571 tem = 2;
1572 }
1573 }
1574 else if (op == OP_ADL_FUNC)
1575 {
1576 /* Save the function position and move pos so that the arguments
1577 can be evaluated. */
1578 int func_name_len;
1579
1580 save_pos1 = *pos;
1581 tem = 1;
1582
1583 func_name_len = longest_to_int (exp->elts[save_pos1 + 3].longconst);
1584 (*pos) += 6 + BYTES_TO_EXP_ELEM (func_name_len + 1);
1585 }
1586 else
1587 {
1588 /* Non-method function call. */
1589 save_pos1 = *pos;
1590 tem = 1;
1591
1592 /* If this is a C++ function wait until overload resolution. */
1593 if (op == OP_VAR_VALUE
1594 && overload_resolution
1595 && (exp->language_defn->la_language == language_cplus))
1596 {
1597 (*pos) += 4; /* Skip the evaluation of the symbol. */
1598 argvec[0] = NULL;
1599 }
1600 else
1601 {
1602 if (op == OP_VAR_MSYM_VALUE)
1603 {
1604 symbol *sym = exp->elts[*pos + 2].symbol;
1605 var_func_name = SYMBOL_PRINT_NAME (sym);
1606 }
1607 else if (op == OP_VAR_VALUE)
1608 {
1609 minimal_symbol *msym = exp->elts[*pos + 2].msymbol;
1610 var_func_name = MSYMBOL_PRINT_NAME (msym);
1611 }
1612
1613 argvec[0] = evaluate_subexp_with_coercion (exp, pos, noside);
1614 type = value_type (argvec[0]);
1615 if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1616 type = TYPE_TARGET_TYPE (type);
1617 if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
1618 {
1619 for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
1620 {
1621 argvec[tem] = evaluate_subexp (TYPE_FIELD_TYPE (type,
1622 tem - 1),
1623 exp, pos, noside);
1624 }
1625 }
1626 }
1627 }
1628
1629 /* Evaluate arguments (if not already done, e.g., namespace::func()
1630 and overload-resolution is off). */
1631 for (; tem <= nargs; tem++)
1632 {
1633 /* Ensure that array expressions are coerced into pointer
1634 objects. */
1635 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1636 }
1637
1638 /* Signal end of arglist. */
1639 argvec[tem] = 0;
1640
1641 if (noside == EVAL_SKIP)
1642 return eval_skip_value (exp);
1643
1644 if (op == OP_ADL_FUNC)
1645 {
1646 struct symbol *symp;
1647 char *func_name;
1648 int name_len;
1649 int string_pc = save_pos1 + 3;
1650
1651 /* Extract the function name. */
1652 name_len = longest_to_int (exp->elts[string_pc].longconst);
1653 func_name = (char *) alloca (name_len + 1);
1654 strcpy (func_name, &exp->elts[string_pc + 1].string);
1655
1656 find_overload_match (&argvec[1], nargs, func_name,
1657 NON_METHOD, /* not method */
1658 NULL, NULL, /* pass NULL symbol since
1659 symbol is unknown */
1660 NULL, &symp, NULL, 0, noside);
1661
1662 /* Now fix the expression being evaluated. */
1663 exp->elts[save_pos1 + 2].symbol = symp;
1664 argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1, noside);
1665 }
1666
1667 if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR
1668 || (op == OP_SCOPE && function_name != NULL))
1669 {
1670 int static_memfuncp;
1671 char *tstr;
1672
1673 /* Method invocation: stuff "this" as first parameter.
1674 If the method turns out to be static we undo this below. */
1675 argvec[1] = arg2;
1676
1677 if (op != OP_SCOPE)
1678 {
1679 /* Name of method from expression. */
1680 tstr = &exp->elts[pc2 + 2].string;
1681 }
1682 else
1683 tstr = function_name;
1684
1685 if (overload_resolution && (exp->language_defn->la_language
1686 == language_cplus))
1687 {
1688 /* Language is C++, do some overload resolution before
1689 evaluation. */
1690 struct value *valp = NULL;
1691
1692 (void) find_overload_match (&argvec[1], nargs, tstr,
1693 METHOD, /* method */
1694 &arg2, /* the object */
1695 NULL, &valp, NULL,
1696 &static_memfuncp, 0, noside);
1697
1698 if (op == OP_SCOPE && !static_memfuncp)
1699 {
1700 /* For the time being, we don't handle this. */
1701 error (_("Call to overloaded function %s requires "
1702 "`this' pointer"),
1703 function_name);
1704 }
1705 argvec[1] = arg2; /* the ``this'' pointer */
1706 argvec[0] = valp; /* Use the method found after overload
1707 resolution. */
1708 }
1709 else
1710 /* Non-C++ case -- or no overload resolution. */
1711 {
1712 struct value *temp = arg2;
1713
1714 argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1715 &static_memfuncp,
1716 op == STRUCTOP_STRUCT
1717 ? "structure" : "structure pointer");
1718 /* value_struct_elt updates temp with the correct value
1719 of the ``this'' pointer if necessary, so modify argvec[1] to
1720 reflect any ``this'' changes. */
1721 arg2
1722 = value_from_longest (lookup_pointer_type(value_type (temp)),
1723 value_address (temp)
1724 + value_embedded_offset (temp));
1725 argvec[1] = arg2; /* the ``this'' pointer */
1726 }
1727
1728 /* Take out `this' if needed. */
1729 if (static_memfuncp)
1730 {
1731 argvec[1] = argvec[0];
1732 nargs--;
1733 argvec++;
1734 }
1735 }
1736 else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
1737 {
1738 /* Pointer to member. argvec[1] is already set up. */
1739 argvec[0] = arg1;
1740 }
1741 else if (op == OP_VAR_VALUE || (op == OP_SCOPE && function != NULL))
1742 {
1743 /* Non-member function being called. */
1744 /* fn: This can only be done for C++ functions. A C-style function
1745 in a C++ program, for instance, does not have the fields that
1746 are expected here. */
1747
1748 if (overload_resolution && (exp->language_defn->la_language
1749 == language_cplus))
1750 {
1751 /* Language is C++, do some overload resolution before
1752 evaluation. */
1753 struct symbol *symp;
1754 int no_adl = 0;
1755
1756 /* If a scope has been specified disable ADL. */
1757 if (op == OP_SCOPE)
1758 no_adl = 1;
1759
1760 if (op == OP_VAR_VALUE)
1761 function = exp->elts[save_pos1+2].symbol;
1762
1763 (void) find_overload_match (&argvec[1], nargs,
1764 NULL, /* no need for name */
1765 NON_METHOD, /* not method */
1766 NULL, function, /* the function */
1767 NULL, &symp, NULL, no_adl, noside);
1768
1769 if (op == OP_VAR_VALUE)
1770 {
1771 /* Now fix the expression being evaluated. */
1772 exp->elts[save_pos1+2].symbol = symp;
1773 argvec[0] = evaluate_subexp_with_coercion (exp, &save_pos1,
1774 noside);
1775 }
1776 else
1777 argvec[0] = value_of_variable (symp, get_selected_block (0));
1778 }
1779 else
1780 {
1781 /* Not C++, or no overload resolution allowed. */
1782 /* Nothing to be done; argvec already correctly set up. */
1783 }
1784 }
1785 else
1786 {
1787 /* It is probably a C-style function. */
1788 /* Nothing to be done; argvec already correctly set up. */
1789 }
1790
1791 do_call_it:
1792
1793 if (argvec[0] == NULL)
1794 error (_("Cannot evaluate function -- may be inlined"));
1795 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1796 {
1797 /* If the return type doesn't look like a function type,
1798 call an error. This can happen if somebody tries to turn
1799 a variable into a function call. */
1800
1801 struct type *ftype = value_type (argvec[0]);
1802
1803 if (TYPE_CODE (ftype) == TYPE_CODE_INTERNAL_FUNCTION)
1804 {
1805 /* We don't know anything about what the internal
1806 function might return, but we have to return
1807 something. */
1808 return value_zero (builtin_type (exp->gdbarch)->builtin_int,
1809 not_lval);
1810 }
1811 else if (TYPE_CODE (ftype) == TYPE_CODE_XMETHOD)
1812 {
1813 struct type *return_type
1814 = result_type_of_xmethod (argvec[0], nargs, argvec + 1);
1815
1816 if (return_type == NULL)
1817 error (_("Xmethod is missing return type."));
1818 return value_zero (return_type, not_lval);
1819 }
1820 else if (TYPE_CODE (ftype) == TYPE_CODE_FUNC
1821 || TYPE_CODE (ftype) == TYPE_CODE_METHOD)
1822 {
1823 struct type *return_type = TYPE_TARGET_TYPE (ftype);
1824
1825 if (return_type == NULL)
1826 return_type = expect_type;
1827
1828 if (return_type == NULL)
1829 error_call_unknown_return_type (var_func_name);
1830
1831 return allocate_value (return_type);
1832 }
1833 else
1834 error (_("Expression of type other than "
1835 "\"Function returning ...\" used as function"));
1836 }
1837 switch (TYPE_CODE (value_type (argvec[0])))
1838 {
1839 case TYPE_CODE_INTERNAL_FUNCTION:
1840 return call_internal_function (exp->gdbarch, exp->language_defn,
1841 argvec[0], nargs, argvec + 1);
1842 case TYPE_CODE_XMETHOD:
1843 return call_xmethod (argvec[0], nargs, argvec + 1);
1844 default:
1845 return call_function_by_hand (argvec[0],
1846 expect_type, nargs, argvec + 1);
1847 }
1848 /* pai: FIXME save value from call_function_by_hand, then adjust
1849 pc by adjust_fn_pc if +ve. */
1850
1851 case OP_F77_UNDETERMINED_ARGLIST:
1852
1853 /* Remember that in F77, functions, substring ops and
1854 array subscript operations cannot be disambiguated
1855 at parse time. We have made all array subscript operations,
1856 substring operations as well as function calls come here
1857 and we now have to discover what the heck this thing actually was.
1858 If it is a function, we process just as if we got an OP_FUNCALL. */
1859
1860 nargs = longest_to_int (exp->elts[pc + 1].longconst);
1861 (*pos) += 2;
1862
1863 /* First determine the type code we are dealing with. */
1864 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1865 type = check_typedef (value_type (arg1));
1866 code = TYPE_CODE (type);
1867
1868 if (code == TYPE_CODE_PTR)
1869 {
1870 /* Fortran always passes variable to subroutines as pointer.
1871 So we need to look into its target type to see if it is
1872 array, string or function. If it is, we need to switch
1873 to the target value the original one points to. */
1874 struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1875
1876 if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1877 || TYPE_CODE (target_type) == TYPE_CODE_STRING
1878 || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1879 {
1880 arg1 = value_ind (arg1);
1881 type = check_typedef (value_type (arg1));
1882 code = TYPE_CODE (type);
1883 }
1884 }
1885
1886 switch (code)
1887 {
1888 case TYPE_CODE_ARRAY:
1889 if (exp->elts[*pos].opcode == OP_RANGE)
1890 return value_f90_subarray (arg1, exp, pos, noside);
1891 else
1892 goto multi_f77_subscript;
1893
1894 case TYPE_CODE_STRING:
1895 if (exp->elts[*pos].opcode == OP_RANGE)
1896 return value_f90_subarray (arg1, exp, pos, noside);
1897 else
1898 {
1899 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1900 return value_subscript (arg1, value_as_long (arg2));
1901 }
1902
1903 case TYPE_CODE_PTR:
1904 case TYPE_CODE_FUNC:
1905 /* It's a function call. */
1906 /* Allocate arg vector, including space for the function to be
1907 called in argvec[0] and a terminating NULL. */
1908 argvec = (struct value **)
1909 alloca (sizeof (struct value *) * (nargs + 2));
1910 argvec[0] = arg1;
1911 tem = 1;
1912 for (; tem <= nargs; tem++)
1913 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1914 argvec[tem] = 0; /* signal end of arglist */
1915 if (noside == EVAL_SKIP)
1916 return eval_skip_value (exp);
1917 goto do_call_it;
1918
1919 default:
1920 error (_("Cannot perform substring on this type"));
1921 }
1922
1923 case OP_COMPLEX:
1924 /* We have a complex number, There should be 2 floating
1925 point numbers that compose it. */
1926 (*pos) += 2;
1927 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1928 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1929
1930 return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
1931
1932 case STRUCTOP_STRUCT:
1933 tem = longest_to_int (exp->elts[pc + 1].longconst);
1934 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1935 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1936 if (noside == EVAL_SKIP)
1937 return eval_skip_value (exp);
1938 arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
1939 NULL, "structure");
1940 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1941 arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
1942 return arg3;
1943
1944 case STRUCTOP_PTR:
1945 tem = longest_to_int (exp->elts[pc + 1].longconst);
1946 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1947 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1948 if (noside == EVAL_SKIP)
1949 return eval_skip_value (exp);
1950
1951 /* Check to see if operator '->' has been overloaded. If so replace
1952 arg1 with the value returned by evaluating operator->(). */
1953 while (unop_user_defined_p (op, arg1))
1954 {
1955 struct value *value = NULL;
1956 TRY
1957 {
1958 value = value_x_unop (arg1, op, noside);
1959 }
1960
1961 CATCH (except, RETURN_MASK_ERROR)
1962 {
1963 if (except.error == NOT_FOUND_ERROR)
1964 break;
1965 else
1966 throw_exception (except);
1967 }
1968 END_CATCH
1969
1970 arg1 = value;
1971 }
1972
1973 /* JYG: if print object is on we need to replace the base type
1974 with rtti type in order to continue on with successful
1975 lookup of member / method only available in the rtti type. */
1976 {
1977 struct type *type = value_type (arg1);
1978 struct type *real_type;
1979 int full, using_enc;
1980 LONGEST top;
1981 struct value_print_options opts;
1982
1983 get_user_print_options (&opts);
1984 if (opts.objectprint && TYPE_TARGET_TYPE(type)
1985 && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRUCT))
1986 {
1987 real_type = value_rtti_indirect_type (arg1, &full, &top,
1988 &using_enc);
1989 if (real_type)
1990 arg1 = value_cast (real_type, arg1);
1991 }
1992 }
1993
1994 arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
1995 NULL, "structure pointer");
1996 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1997 arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
1998 return arg3;
1999
2000 case STRUCTOP_MEMBER:
2001 case STRUCTOP_MPTR:
2002 if (op == STRUCTOP_MEMBER)
2003 arg1 = evaluate_subexp_for_address (exp, pos, noside);
2004 else
2005 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2006
2007 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2008
2009 if (noside == EVAL_SKIP)
2010 return eval_skip_value (exp);
2011
2012 type = check_typedef (value_type (arg2));
2013 switch (TYPE_CODE (type))
2014 {
2015 case TYPE_CODE_METHODPTR:
2016 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2017 return value_zero (TYPE_TARGET_TYPE (type), not_lval);
2018 else
2019 {
2020 arg2 = cplus_method_ptr_to_value (&arg1, arg2);
2021 gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
2022 return value_ind (arg2);
2023 }
2024
2025 case TYPE_CODE_MEMBERPTR:
2026 /* Now, convert these values to an address. */
2027 arg1 = value_cast_pointers (lookup_pointer_type (TYPE_SELF_TYPE (type)),
2028 arg1, 1);
2029
2030 mem_offset = value_as_long (arg2);
2031
2032 arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2033 value_as_long (arg1) + mem_offset);
2034 return value_ind (arg3);
2035
2036 default:
2037 error (_("non-pointer-to-member value used "
2038 "in pointer-to-member construct"));
2039 }
2040
2041 case TYPE_INSTANCE:
2042 nargs = longest_to_int (exp->elts[pc + 1].longconst);
2043 arg_types = (struct type **) alloca (nargs * sizeof (struct type *));
2044 for (ix = 0; ix < nargs; ++ix)
2045 arg_types[ix] = exp->elts[pc + 1 + ix + 1].type;
2046
2047 expect_type = make_params (nargs, arg_types);
2048 *(pos) += 3 + nargs;
2049 arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
2050 xfree (TYPE_FIELDS (expect_type));
2051 xfree (TYPE_MAIN_TYPE (expect_type));
2052 xfree (expect_type);
2053 return arg1;
2054
2055 case BINOP_CONCAT:
2056 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2057 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2058 if (noside == EVAL_SKIP)
2059 return eval_skip_value (exp);
2060 if (binop_user_defined_p (op, arg1, arg2))
2061 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2062 else
2063 return value_concat (arg1, arg2);
2064
2065 case BINOP_ASSIGN:
2066 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2067 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2068
2069 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2070 return arg1;
2071 if (binop_user_defined_p (op, arg1, arg2))
2072 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2073 else
2074 return value_assign (arg1, arg2);
2075
2076 case BINOP_ASSIGN_MODIFY:
2077 (*pos) += 2;
2078 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2079 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2080 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2081 return arg1;
2082 op = exp->elts[pc + 1].opcode;
2083 if (binop_user_defined_p (op, arg1, arg2))
2084 return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
2085 else if (op == BINOP_ADD && ptrmath_type_p (exp->language_defn,
2086 value_type (arg1))
2087 && is_integral_type (value_type (arg2)))
2088 arg2 = value_ptradd (arg1, value_as_long (arg2));
2089 else if (op == BINOP_SUB && ptrmath_type_p (exp->language_defn,
2090 value_type (arg1))
2091 && is_integral_type (value_type (arg2)))
2092 arg2 = value_ptradd (arg1, - value_as_long (arg2));
2093 else
2094 {
2095 struct value *tmp = arg1;
2096
2097 /* For shift and integer exponentiation operations,
2098 only promote the first argument. */
2099 if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2100 && is_integral_type (value_type (arg2)))
2101 unop_promote (exp->language_defn, exp->gdbarch, &tmp);
2102 else
2103 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2104
2105 arg2 = value_binop (tmp, arg2, op);
2106 }
2107 return value_assign (arg1, arg2);
2108
2109 case BINOP_ADD:
2110 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2111 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2112 if (noside == EVAL_SKIP)
2113 return eval_skip_value (exp);
2114 if (binop_user_defined_p (op, arg1, arg2))
2115 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2116 else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2117 && is_integral_type (value_type (arg2)))
2118 return value_ptradd (arg1, value_as_long (arg2));
2119 else if (ptrmath_type_p (exp->language_defn, value_type (arg2))
2120 && is_integral_type (value_type (arg1)))
2121 return value_ptradd (arg2, value_as_long (arg1));
2122 else
2123 {
2124 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2125 return value_binop (arg1, arg2, BINOP_ADD);
2126 }
2127
2128 case BINOP_SUB:
2129 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2130 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2131 if (noside == EVAL_SKIP)
2132 return eval_skip_value (exp);
2133 if (binop_user_defined_p (op, arg1, arg2))
2134 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2135 else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2136 && ptrmath_type_p (exp->language_defn, value_type (arg2)))
2137 {
2138 /* FIXME -- should be ptrdiff_t */
2139 type = builtin_type (exp->gdbarch)->builtin_long;
2140 return value_from_longest (type, value_ptrdiff (arg1, arg2));
2141 }
2142 else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2143 && is_integral_type (value_type (arg2)))
2144 return value_ptradd (arg1, - value_as_long (arg2));
2145 else
2146 {
2147 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2148 return value_binop (arg1, arg2, BINOP_SUB);
2149 }
2150
2151 case BINOP_EXP:
2152 case BINOP_MUL:
2153 case BINOP_DIV:
2154 case BINOP_INTDIV:
2155 case BINOP_REM:
2156 case BINOP_MOD:
2157 case BINOP_LSH:
2158 case BINOP_RSH:
2159 case BINOP_BITWISE_AND:
2160 case BINOP_BITWISE_IOR:
2161 case BINOP_BITWISE_XOR:
2162 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2163 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2164 if (noside == EVAL_SKIP)
2165 return eval_skip_value (exp);
2166 if (binop_user_defined_p (op, arg1, arg2))
2167 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2168 else
2169 {
2170 /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
2171 fudge arg2 to avoid division-by-zero, the caller is
2172 (theoretically) only looking for the type of the result. */
2173 if (noside == EVAL_AVOID_SIDE_EFFECTS
2174 /* ??? Do we really want to test for BINOP_MOD here?
2175 The implementation of value_binop gives it a well-defined
2176 value. */
2177 && (op == BINOP_DIV
2178 || op == BINOP_INTDIV
2179 || op == BINOP_REM
2180 || op == BINOP_MOD)
2181 && value_logical_not (arg2))
2182 {
2183 struct value *v_one, *retval;
2184
2185 v_one = value_one (value_type (arg2));
2186 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
2187 retval = value_binop (arg1, v_one, op);
2188 return retval;
2189 }
2190 else
2191 {
2192 /* For shift and integer exponentiation operations,
2193 only promote the first argument. */
2194 if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2195 && is_integral_type (value_type (arg2)))
2196 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2197 else
2198 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2199
2200 return value_binop (arg1, arg2, op);
2201 }
2202 }
2203
2204 case BINOP_SUBSCRIPT:
2205 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2206 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2207 if (noside == EVAL_SKIP)
2208 return eval_skip_value (exp);
2209 if (binop_user_defined_p (op, arg1, arg2))
2210 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2211 else
2212 {
2213 /* If the user attempts to subscript something that is not an
2214 array or pointer type (like a plain int variable for example),
2215 then report this as an error. */
2216
2217 arg1 = coerce_ref (arg1);
2218 type = check_typedef (value_type (arg1));
2219 if (TYPE_CODE (type) != TYPE_CODE_ARRAY
2220 && TYPE_CODE (type) != TYPE_CODE_PTR)
2221 {
2222 if (TYPE_NAME (type))
2223 error (_("cannot subscript something of type `%s'"),
2224 TYPE_NAME (type));
2225 else
2226 error (_("cannot subscript requested type"));
2227 }
2228
2229 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2230 return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
2231 else
2232 return value_subscript (arg1, value_as_long (arg2));
2233 }
2234 case MULTI_SUBSCRIPT:
2235 (*pos) += 2;
2236 nargs = longest_to_int (exp->elts[pc + 1].longconst);
2237 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2238 while (nargs-- > 0)
2239 {
2240 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2241 /* FIXME: EVAL_SKIP handling may not be correct. */
2242 if (noside == EVAL_SKIP)
2243 {
2244 if (nargs > 0)
2245 continue;
2246 return eval_skip_value (exp);
2247 }
2248 /* FIXME: EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
2249 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2250 {
2251 /* If the user attempts to subscript something that has no target
2252 type (like a plain int variable for example), then report this
2253 as an error. */
2254
2255 type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
2256 if (type != NULL)
2257 {
2258 arg1 = value_zero (type, VALUE_LVAL (arg1));
2259 noside = EVAL_SKIP;
2260 continue;
2261 }
2262 else
2263 {
2264 error (_("cannot subscript something of type `%s'"),
2265 TYPE_NAME (value_type (arg1)));
2266 }
2267 }
2268
2269 if (binop_user_defined_p (op, arg1, arg2))
2270 {
2271 arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
2272 }
2273 else
2274 {
2275 arg1 = coerce_ref (arg1);
2276 type = check_typedef (value_type (arg1));
2277
2278 switch (TYPE_CODE (type))
2279 {
2280 case TYPE_CODE_PTR:
2281 case TYPE_CODE_ARRAY:
2282 case TYPE_CODE_STRING:
2283 arg1 = value_subscript (arg1, value_as_long (arg2));
2284 break;
2285
2286 default:
2287 if (TYPE_NAME (type))
2288 error (_("cannot subscript something of type `%s'"),
2289 TYPE_NAME (type));
2290 else
2291 error (_("cannot subscript requested type"));
2292 }
2293 }
2294 }
2295 return (arg1);
2296
2297 multi_f77_subscript:
2298 {
2299 LONGEST subscript_array[MAX_FORTRAN_DIMS];
2300 int ndimensions = 1, i;
2301 struct value *array = arg1;
2302
2303 if (nargs > MAX_FORTRAN_DIMS)
2304 error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
2305
2306 ndimensions = calc_f77_array_dims (type);
2307
2308 if (nargs != ndimensions)
2309 error (_("Wrong number of subscripts"));
2310
2311 gdb_assert (nargs > 0);
2312
2313 /* Now that we know we have a legal array subscript expression
2314 let us actually find out where this element exists in the array. */
2315
2316 /* Take array indices left to right. */
2317 for (i = 0; i < nargs; i++)
2318 {
2319 /* Evaluate each subscript; it must be a legal integer in F77. */
2320 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2321
2322 /* Fill in the subscript array. */
2323
2324 subscript_array[i] = value_as_long (arg2);
2325 }
2326
2327 /* Internal type of array is arranged right to left. */
2328 for (i = nargs; i > 0; i--)
2329 {
2330 struct type *array_type = check_typedef (value_type (array));
2331 LONGEST index = subscript_array[i - 1];
2332
2333 array = value_subscripted_rvalue (array, index,
2334 f77_get_lowerbound (array_type));
2335 }
2336
2337 return array;
2338 }
2339
2340 case BINOP_LOGICAL_AND:
2341 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2342 if (noside == EVAL_SKIP)
2343 {
2344 evaluate_subexp (NULL_TYPE, exp, pos, noside);
2345 return eval_skip_value (exp);
2346 }
2347
2348 oldpos = *pos;
2349 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2350 *pos = oldpos;
2351
2352 if (binop_user_defined_p (op, arg1, arg2))
2353 {
2354 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2355 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2356 }
2357 else
2358 {
2359 tem = value_logical_not (arg1);
2360 arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2361 (tem ? EVAL_SKIP : noside));
2362 type = language_bool_type (exp->language_defn, exp->gdbarch);
2363 return value_from_longest (type,
2364 (LONGEST) (!tem && !value_logical_not (arg2)));
2365 }
2366
2367 case BINOP_LOGICAL_OR:
2368 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2369 if (noside == EVAL_SKIP)
2370 {
2371 evaluate_subexp (NULL_TYPE, exp, pos, noside);
2372 return eval_skip_value (exp);
2373 }
2374
2375 oldpos = *pos;
2376 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2377 *pos = oldpos;
2378
2379 if (binop_user_defined_p (op, arg1, arg2))
2380 {
2381 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2382 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2383 }
2384 else
2385 {
2386 tem = value_logical_not (arg1);
2387 arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2388 (!tem ? EVAL_SKIP : noside));
2389 type = language_bool_type (exp->language_defn, exp->gdbarch);
2390 return value_from_longest (type,
2391 (LONGEST) (!tem || !value_logical_not (arg2)));
2392 }
2393
2394 case BINOP_EQUAL:
2395 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2396 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2397 if (noside == EVAL_SKIP)
2398 return eval_skip_value (exp);
2399 if (binop_user_defined_p (op, arg1, arg2))
2400 {
2401 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2402 }
2403 else
2404 {
2405 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2406 tem = value_equal (arg1, arg2);
2407 type = language_bool_type (exp->language_defn, exp->gdbarch);
2408 return value_from_longest (type, (LONGEST) tem);
2409 }
2410
2411 case BINOP_NOTEQUAL:
2412 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2413 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2414 if (noside == EVAL_SKIP)
2415 return eval_skip_value (exp);
2416 if (binop_user_defined_p (op, arg1, arg2))
2417 {
2418 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2419 }
2420 else
2421 {
2422 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2423 tem = value_equal (arg1, arg2);
2424 type = language_bool_type (exp->language_defn, exp->gdbarch);
2425 return value_from_longest (type, (LONGEST) ! tem);
2426 }
2427
2428 case BINOP_LESS:
2429 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2430 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2431 if (noside == EVAL_SKIP)
2432 return eval_skip_value (exp);
2433 if (binop_user_defined_p (op, arg1, arg2))
2434 {
2435 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2436 }
2437 else
2438 {
2439 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2440 tem = value_less (arg1, arg2);
2441 type = language_bool_type (exp->language_defn, exp->gdbarch);
2442 return value_from_longest (type, (LONGEST) tem);
2443 }
2444
2445 case BINOP_GTR:
2446 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2447 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2448 if (noside == EVAL_SKIP)
2449 return eval_skip_value (exp);
2450 if (binop_user_defined_p (op, arg1, arg2))
2451 {
2452 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2453 }
2454 else
2455 {
2456 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2457 tem = value_less (arg2, arg1);
2458 type = language_bool_type (exp->language_defn, exp->gdbarch);
2459 return value_from_longest (type, (LONGEST) tem);
2460 }
2461
2462 case BINOP_GEQ:
2463 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2464 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2465 if (noside == EVAL_SKIP)
2466 return eval_skip_value (exp);
2467 if (binop_user_defined_p (op, arg1, arg2))
2468 {
2469 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2470 }
2471 else
2472 {
2473 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2474 tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
2475 type = language_bool_type (exp->language_defn, exp->gdbarch);
2476 return value_from_longest (type, (LONGEST) tem);
2477 }
2478
2479 case BINOP_LEQ:
2480 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2481 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
2482 if (noside == EVAL_SKIP)
2483 return eval_skip_value (exp);
2484 if (binop_user_defined_p (op, arg1, arg2))
2485 {
2486 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2487 }
2488 else
2489 {
2490 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2491 tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
2492 type = language_bool_type (exp->language_defn, exp->gdbarch);
2493 return value_from_longest (type, (LONGEST) tem);
2494 }
2495
2496 case BINOP_REPEAT:
2497 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2498 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2499 if (noside == EVAL_SKIP)
2500 return eval_skip_value (exp);
2501 type = check_typedef (value_type (arg2));
2502 if (TYPE_CODE (type) != TYPE_CODE_INT
2503 && TYPE_CODE (type) != TYPE_CODE_ENUM)
2504 error (_("Non-integral right operand for \"@\" operator."));
2505 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2506 {
2507 return allocate_repeat_value (value_type (arg1),
2508 longest_to_int (value_as_long (arg2)));
2509 }
2510 else
2511 return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2512
2513 case BINOP_COMMA:
2514 evaluate_subexp (NULL_TYPE, exp, pos, noside);
2515 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2516
2517 case UNOP_PLUS:
2518 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2519 if (noside == EVAL_SKIP)
2520 return eval_skip_value (exp);
2521 if (unop_user_defined_p (op, arg1))
2522 return value_x_unop (arg1, op, noside);
2523 else
2524 {
2525 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2526 return value_pos (arg1);
2527 }
2528
2529 case UNOP_NEG:
2530 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2531 if (noside == EVAL_SKIP)
2532 return eval_skip_value (exp);
2533 if (unop_user_defined_p (op, arg1))
2534 return value_x_unop (arg1, op, noside);
2535 else
2536 {
2537 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2538 return value_neg (arg1);
2539 }
2540
2541 case UNOP_COMPLEMENT:
2542 /* C++: check for and handle destructor names. */
2543
2544 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2545 if (noside == EVAL_SKIP)
2546 return eval_skip_value (exp);
2547 if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2548 return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2549 else
2550 {
2551 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2552 return value_complement (arg1);
2553 }
2554
2555 case UNOP_LOGICAL_NOT:
2556 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2557 if (noside == EVAL_SKIP)
2558 return eval_skip_value (exp);
2559 if (unop_user_defined_p (op, arg1))
2560 return value_x_unop (arg1, op, noside);
2561 else
2562 {
2563 type = language_bool_type (exp->language_defn, exp->gdbarch);
2564 return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2565 }
2566
2567 case UNOP_IND:
2568 if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
2569 expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
2570 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2571 type = check_typedef (value_type (arg1));
2572 if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2573 || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
2574 error (_("Attempt to dereference pointer "
2575 "to member without an object"));
2576 if (noside == EVAL_SKIP)
2577 return eval_skip_value (exp);
2578 if (unop_user_defined_p (op, arg1))
2579 return value_x_unop (arg1, op, noside);
2580 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2581 {
2582 type = check_typedef (value_type (arg1));
2583 if (TYPE_CODE (type) == TYPE_CODE_PTR
2584 || TYPE_IS_REFERENCE (type)
2585 /* In C you can dereference an array to get the 1st elt. */
2586 || TYPE_CODE (type) == TYPE_CODE_ARRAY
2587 )
2588 return value_zero (TYPE_TARGET_TYPE (type),
2589 lval_memory);
2590 else if (TYPE_CODE (type) == TYPE_CODE_INT)
2591 /* GDB allows dereferencing an int. */
2592 return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2593 lval_memory);
2594 else
2595 error (_("Attempt to take contents of a non-pointer value."));
2596 }
2597
2598 /* Allow * on an integer so we can cast it to whatever we want.
2599 This returns an int, which seems like the most C-like thing to
2600 do. "long long" variables are rare enough that
2601 BUILTIN_TYPE_LONGEST would seem to be a mistake. */
2602 if (TYPE_CODE (type) == TYPE_CODE_INT)
2603 return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2604 (CORE_ADDR) value_as_address (arg1));
2605 return value_ind (arg1);
2606
2607 case UNOP_ADDR:
2608 /* C++: check for and handle pointer to members. */
2609
2610 if (noside == EVAL_SKIP)
2611 {
2612 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2613 return eval_skip_value (exp);
2614 }
2615 else
2616 {
2617 struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2618 noside);
2619
2620 return retvalp;
2621 }
2622
2623 case UNOP_SIZEOF:
2624 if (noside == EVAL_SKIP)
2625 {
2626 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2627 return eval_skip_value (exp);
2628 }
2629 return evaluate_subexp_for_sizeof (exp, pos, noside);
2630
2631 case UNOP_CAST:
2632 (*pos) += 2;
2633 type = exp->elts[pc + 1].type;
2634 return evaluate_subexp_for_cast (exp, pos, noside, type);
2635
2636 case UNOP_CAST_TYPE:
2637 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2638 type = value_type (arg1);
2639 return evaluate_subexp_for_cast (exp, pos, noside, type);
2640
2641 case UNOP_DYNAMIC_CAST:
2642 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2643 type = value_type (arg1);
2644 arg1 = evaluate_subexp (type, exp, pos, noside);
2645 if (noside == EVAL_SKIP)
2646 return eval_skip_value (exp);
2647 return value_dynamic_cast (type, arg1);
2648
2649 case UNOP_REINTERPRET_CAST:
2650 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2651 type = value_type (arg1);
2652 arg1 = evaluate_subexp (type, exp, pos, noside);
2653 if (noside == EVAL_SKIP)
2654 return eval_skip_value (exp);
2655 return value_reinterpret_cast (type, arg1);
2656
2657 case UNOP_MEMVAL:
2658 (*pos) += 2;
2659 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2660 if (noside == EVAL_SKIP)
2661 return eval_skip_value (exp);
2662 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2663 return value_zero (exp->elts[pc + 1].type, lval_memory);
2664 else
2665 return value_at_lazy (exp->elts[pc + 1].type,
2666 value_as_address (arg1));
2667
2668 case UNOP_MEMVAL_TYPE:
2669 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2670 type = value_type (arg1);
2671 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2672 if (noside == EVAL_SKIP)
2673 return eval_skip_value (exp);
2674 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2675 return value_zero (type, lval_memory);
2676 else
2677 return value_at_lazy (type, value_as_address (arg1));
2678
2679 case UNOP_PREINCREMENT:
2680 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2681 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2682 return arg1;
2683 else if (unop_user_defined_p (op, arg1))
2684 {
2685 return value_x_unop (arg1, op, noside);
2686 }
2687 else
2688 {
2689 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2690 arg2 = value_ptradd (arg1, 1);
2691 else
2692 {
2693 struct value *tmp = arg1;
2694
2695 arg2 = value_one (value_type (arg1));
2696 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2697 arg2 = value_binop (tmp, arg2, BINOP_ADD);
2698 }
2699
2700 return value_assign (arg1, arg2);
2701 }
2702
2703 case UNOP_PREDECREMENT:
2704 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2705 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2706 return arg1;
2707 else if (unop_user_defined_p (op, arg1))
2708 {
2709 return value_x_unop (arg1, op, noside);
2710 }
2711 else
2712 {
2713 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2714 arg2 = value_ptradd (arg1, -1);
2715 else
2716 {
2717 struct value *tmp = arg1;
2718
2719 arg2 = value_one (value_type (arg1));
2720 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2721 arg2 = value_binop (tmp, arg2, BINOP_SUB);
2722 }
2723
2724 return value_assign (arg1, arg2);
2725 }
2726
2727 case UNOP_POSTINCREMENT:
2728 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2729 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2730 return arg1;
2731 else if (unop_user_defined_p (op, arg1))
2732 {
2733 return value_x_unop (arg1, op, noside);
2734 }
2735 else
2736 {
2737 arg3 = value_non_lval (arg1);
2738
2739 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2740 arg2 = value_ptradd (arg1, 1);
2741 else
2742 {
2743 struct value *tmp = arg1;
2744
2745 arg2 = value_one (value_type (arg1));
2746 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2747 arg2 = value_binop (tmp, arg2, BINOP_ADD);
2748 }
2749
2750 value_assign (arg1, arg2);
2751 return arg3;
2752 }
2753
2754 case UNOP_POSTDECREMENT:
2755 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2756 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2757 return arg1;
2758 else if (unop_user_defined_p (op, arg1))
2759 {
2760 return value_x_unop (arg1, op, noside);
2761 }
2762 else
2763 {
2764 arg3 = value_non_lval (arg1);
2765
2766 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2767 arg2 = value_ptradd (arg1, -1);
2768 else
2769 {
2770 struct value *tmp = arg1;
2771
2772 arg2 = value_one (value_type (arg1));
2773 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2774 arg2 = value_binop (tmp, arg2, BINOP_SUB);
2775 }
2776
2777 value_assign (arg1, arg2);
2778 return arg3;
2779 }
2780
2781 case OP_THIS:
2782 (*pos) += 1;
2783 return value_of_this (exp->language_defn);
2784
2785 case OP_TYPE:
2786 /* The value is not supposed to be used. This is here to make it
2787 easier to accommodate expressions that contain types. */
2788 (*pos) += 2;
2789 if (noside == EVAL_SKIP)
2790 return eval_skip_value (exp);
2791 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2792 return allocate_value (exp->elts[pc + 1].type);
2793 else
2794 error (_("Attempt to use a type name as an expression"));
2795
2796 case OP_TYPEOF:
2797 case OP_DECLTYPE:
2798 if (noside == EVAL_SKIP)
2799 {
2800 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
2801 return eval_skip_value (exp);
2802 }
2803 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2804 {
2805 enum exp_opcode sub_op = exp->elts[*pos].opcode;
2806 struct value *result;
2807
2808 result = evaluate_subexp (NULL_TYPE, exp, pos,
2809 EVAL_AVOID_SIDE_EFFECTS);
2810
2811 /* 'decltype' has special semantics for lvalues. */
2812 if (op == OP_DECLTYPE
2813 && (sub_op == BINOP_SUBSCRIPT
2814 || sub_op == STRUCTOP_MEMBER
2815 || sub_op == STRUCTOP_MPTR
2816 || sub_op == UNOP_IND
2817 || sub_op == STRUCTOP_STRUCT
2818 || sub_op == STRUCTOP_PTR
2819 || sub_op == OP_SCOPE))
2820 {
2821 struct type *type = value_type (result);
2822
2823 if (!TYPE_IS_REFERENCE (type))
2824 {
2825 type = lookup_lvalue_reference_type (type);
2826 result = allocate_value (type);
2827 }
2828 }
2829
2830 return result;
2831 }
2832 else
2833 error (_("Attempt to use a type as an expression"));
2834
2835 case OP_TYPEID:
2836 {
2837 struct value *result;
2838 enum exp_opcode sub_op = exp->elts[*pos].opcode;
2839
2840 if (sub_op == OP_TYPE || sub_op == OP_DECLTYPE || sub_op == OP_TYPEOF)
2841 result = evaluate_subexp (NULL_TYPE, exp, pos,
2842 EVAL_AVOID_SIDE_EFFECTS);
2843 else
2844 result = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2845
2846 if (noside != EVAL_NORMAL)
2847 return allocate_value (cplus_typeid_type (exp->gdbarch));
2848
2849 return cplus_typeid (result);
2850 }
2851
2852 default:
2853 /* Removing this case and compiling with gcc -Wall reveals that
2854 a lot of cases are hitting this case. Some of these should
2855 probably be removed from expression.h; others are legitimate
2856 expressions which are (apparently) not fully implemented.
2857
2858 If there are any cases landing here which mean a user error,
2859 then they should be separate cases, with more descriptive
2860 error messages. */
2861
2862 error (_("GDB does not (yet) know how to "
2863 "evaluate that kind of expression"));
2864 }
2865
2866 gdb_assert_not_reached ("missed return?");
2867 }
2868 \f
2869 /* Evaluate a subexpression of EXP, at index *POS,
2870 and return the address of that subexpression.
2871 Advance *POS over the subexpression.
2872 If the subexpression isn't an lvalue, get an error.
2873 NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2874 then only the type of the result need be correct. */
2875
2876 static struct value *
2877 evaluate_subexp_for_address (struct expression *exp, int *pos,
2878 enum noside noside)
2879 {
2880 enum exp_opcode op;
2881 int pc;
2882 struct symbol *var;
2883 struct value *x;
2884 int tem;
2885
2886 pc = (*pos);
2887 op = exp->elts[pc].opcode;
2888
2889 switch (op)
2890 {
2891 case UNOP_IND:
2892 (*pos)++;
2893 x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2894
2895 /* We can't optimize out "&*" if there's a user-defined operator*. */
2896 if (unop_user_defined_p (op, x))
2897 {
2898 x = value_x_unop (x, op, noside);
2899 goto default_case_after_eval;
2900 }
2901
2902 return coerce_array (x);
2903
2904 case UNOP_MEMVAL:
2905 (*pos) += 3;
2906 return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2907 evaluate_subexp (NULL_TYPE, exp, pos, noside));
2908
2909 case UNOP_MEMVAL_TYPE:
2910 {
2911 struct type *type;
2912
2913 (*pos) += 1;
2914 x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2915 type = value_type (x);
2916 return value_cast (lookup_pointer_type (type),
2917 evaluate_subexp (NULL_TYPE, exp, pos, noside));
2918 }
2919
2920 case OP_VAR_VALUE:
2921 var = exp->elts[pc + 2].symbol;
2922
2923 /* C++: The "address" of a reference should yield the address
2924 * of the object pointed to. Let value_addr() deal with it. */
2925 if (TYPE_IS_REFERENCE (SYMBOL_TYPE (var)))
2926 goto default_case;
2927
2928 (*pos) += 4;
2929 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2930 {
2931 struct type *type =
2932 lookup_pointer_type (SYMBOL_TYPE (var));
2933 enum address_class sym_class = SYMBOL_CLASS (var);
2934
2935 if (sym_class == LOC_CONST
2936 || sym_class == LOC_CONST_BYTES
2937 || sym_class == LOC_REGISTER)
2938 error (_("Attempt to take address of register or constant."));
2939
2940 return
2941 value_zero (type, not_lval);
2942 }
2943 else
2944 return address_of_variable (var, exp->elts[pc + 1].block);
2945
2946 case OP_VAR_MSYM_VALUE:
2947 {
2948 (*pos) += 4;
2949
2950 value *val = evaluate_var_msym_value (noside,
2951 exp->elts[pc + 1].objfile,
2952 exp->elts[pc + 2].msymbol);
2953 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2954 {
2955 struct type *type = lookup_pointer_type (value_type (val));
2956 return value_zero (type, not_lval);
2957 }
2958 else
2959 return value_addr (val);
2960 }
2961
2962 case OP_SCOPE:
2963 tem = longest_to_int (exp->elts[pc + 2].longconst);
2964 (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
2965 x = value_aggregate_elt (exp->elts[pc + 1].type,
2966 &exp->elts[pc + 3].string,
2967 NULL, 1, noside);
2968 if (x == NULL)
2969 error (_("There is no field named %s"), &exp->elts[pc + 3].string);
2970 return x;
2971
2972 default:
2973 default_case:
2974 x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2975 default_case_after_eval:
2976 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2977 {
2978 struct type *type = check_typedef (value_type (x));
2979
2980 if (TYPE_IS_REFERENCE (type))
2981 return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2982 not_lval);
2983 else if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
2984 return value_zero (lookup_pointer_type (value_type (x)),
2985 not_lval);
2986 else
2987 error (_("Attempt to take address of "
2988 "value not located in memory."));
2989 }
2990 return value_addr (x);
2991 }
2992 }
2993
2994 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2995 When used in contexts where arrays will be coerced anyway, this is
2996 equivalent to `evaluate_subexp' but much faster because it avoids
2997 actually fetching array contents (perhaps obsolete now that we have
2998 value_lazy()).
2999
3000 Note that we currently only do the coercion for C expressions, where
3001 arrays are zero based and the coercion is correct. For other languages,
3002 with nonzero based arrays, coercion loses. Use CAST_IS_CONVERSION
3003 to decide if coercion is appropriate. */
3004
3005 struct value *
3006 evaluate_subexp_with_coercion (struct expression *exp,
3007 int *pos, enum noside noside)
3008 {
3009 enum exp_opcode op;
3010 int pc;
3011 struct value *val;
3012 struct symbol *var;
3013 struct type *type;
3014
3015 pc = (*pos);
3016 op = exp->elts[pc].opcode;
3017
3018 switch (op)
3019 {
3020 case OP_VAR_VALUE:
3021 var = exp->elts[pc + 2].symbol;
3022 type = check_typedef (SYMBOL_TYPE (var));
3023 if (TYPE_CODE (type) == TYPE_CODE_ARRAY
3024 && !TYPE_VECTOR (type)
3025 && CAST_IS_CONVERSION (exp->language_defn))
3026 {
3027 (*pos) += 4;
3028 val = address_of_variable (var, exp->elts[pc + 1].block);
3029 return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3030 val);
3031 }
3032 /* FALLTHROUGH */
3033
3034 default:
3035 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
3036 }
3037 }
3038
3039 /* Evaluate a subexpression of EXP, at index *POS,
3040 and return a value for the size of that subexpression.
3041 Advance *POS over the subexpression. If NOSIDE is EVAL_NORMAL
3042 we allow side-effects on the operand if its type is a variable
3043 length array. */
3044
3045 static struct value *
3046 evaluate_subexp_for_sizeof (struct expression *exp, int *pos,
3047 enum noside noside)
3048 {
3049 /* FIXME: This should be size_t. */
3050 struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
3051 enum exp_opcode op;
3052 int pc;
3053 struct type *type;
3054 struct value *val;
3055
3056 pc = (*pos);
3057 op = exp->elts[pc].opcode;
3058
3059 switch (op)
3060 {
3061 /* This case is handled specially
3062 so that we avoid creating a value for the result type.
3063 If the result type is very big, it's desirable not to
3064 create a value unnecessarily. */
3065 case UNOP_IND:
3066 (*pos)++;
3067 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3068 type = check_typedef (value_type (val));
3069 if (TYPE_CODE (type) != TYPE_CODE_PTR
3070 && !TYPE_IS_REFERENCE (type)
3071 && TYPE_CODE (type) != TYPE_CODE_ARRAY)
3072 error (_("Attempt to take contents of a non-pointer value."));
3073 type = TYPE_TARGET_TYPE (type);
3074 if (is_dynamic_type (type))
3075 type = value_type (value_ind (val));
3076 return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3077
3078 case UNOP_MEMVAL:
3079 (*pos) += 3;
3080 type = exp->elts[pc + 1].type;
3081 break;
3082
3083 case UNOP_MEMVAL_TYPE:
3084 (*pos) += 1;
3085 val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3086 type = value_type (val);
3087 break;
3088
3089 case OP_VAR_VALUE:
3090 type = SYMBOL_TYPE (exp->elts[pc + 2].symbol);
3091 if (is_dynamic_type (type))
3092 {
3093 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3094 type = value_type (val);
3095 }
3096 else
3097 (*pos) += 4;
3098 break;
3099
3100 case OP_VAR_MSYM_VALUE:
3101 {
3102 (*pos) += 4;
3103
3104 minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
3105 value *val = evaluate_var_msym_value (noside,
3106 exp->elts[pc + 1].objfile,
3107 msymbol);
3108
3109 type = value_type (val);
3110 if (TYPE_CODE (type) == TYPE_CODE_ERROR)
3111 error_unknown_type (MSYMBOL_PRINT_NAME (msymbol));
3112
3113 return value_from_longest (size_type, TYPE_LENGTH (type));
3114 }
3115 break;
3116
3117 /* Deal with the special case if NOSIDE is EVAL_NORMAL and the resulting
3118 type of the subscript is a variable length array type. In this case we
3119 must re-evaluate the right hand side of the subcription to allow
3120 side-effects. */
3121 case BINOP_SUBSCRIPT:
3122 if (noside == EVAL_NORMAL)
3123 {
3124 int pc = (*pos) + 1;
3125
3126 val = evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
3127 type = check_typedef (value_type (val));
3128 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3129 {
3130 type = check_typedef (TYPE_TARGET_TYPE (type));
3131 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3132 {
3133 type = TYPE_INDEX_TYPE (type);
3134 /* Only re-evaluate the right hand side if the resulting type
3135 is a variable length type. */
3136 if (TYPE_RANGE_DATA (type)->flag_bound_evaluated)
3137 {
3138 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3139 return value_from_longest
3140 (size_type, (LONGEST) TYPE_LENGTH (value_type (val)));
3141 }
3142 }
3143 }
3144 }
3145
3146 /* Fall through. */
3147
3148 default:
3149 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
3150 type = value_type (val);
3151 break;
3152 }
3153
3154 /* $5.3.3/2 of the C++ Standard (n3290 draft) says of sizeof:
3155 "When applied to a reference or a reference type, the result is
3156 the size of the referenced type." */
3157 type = check_typedef (type);
3158 if (exp->language_defn->la_language == language_cplus
3159 && (TYPE_IS_REFERENCE (type)))
3160 type = check_typedef (TYPE_TARGET_TYPE (type));
3161 return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
3162 }
3163
3164 /* Evaluate a subexpression of EXP, at index *POS, and return a value
3165 for that subexpression cast to TO_TYPE. Advance *POS over the
3166 subexpression. */
3167
3168 static value *
3169 evaluate_subexp_for_cast (expression *exp, int *pos,
3170 enum noside noside,
3171 struct type *to_type)
3172 {
3173 int pc = *pos;
3174
3175 /* Don't let symbols be evaluated with evaluate_subexp because that
3176 throws an "unknown type" error for no-debug data symbols.
3177 Instead, we want the cast to reinterpret the symbol. */
3178 if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE
3179 || exp->elts[pc].opcode == OP_VAR_VALUE)
3180 {
3181 (*pos) += 4;
3182
3183 value *val;
3184 if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
3185 {
3186 if (noside == EVAL_AVOID_SIDE_EFFECTS)
3187 return value_zero (to_type, not_lval);
3188
3189 val = evaluate_var_msym_value (noside,
3190 exp->elts[pc + 1].objfile,
3191 exp->elts[pc + 2].msymbol);
3192 }
3193 else
3194 val = evaluate_var_value (noside,
3195 exp->elts[pc + 1].block,
3196 exp->elts[pc + 2].symbol);
3197
3198 if (noside == EVAL_SKIP)
3199 return eval_skip_value (exp);
3200
3201 val = value_cast (to_type, val);
3202
3203 /* Don't allow e.g. '&(int)var_with_no_debug_info'. */
3204 if (VALUE_LVAL (val) == lval_memory)
3205 {
3206 if (value_lazy (val))
3207 value_fetch_lazy (val);
3208 VALUE_LVAL (val) = not_lval;
3209 }
3210 return val;
3211 }
3212
3213 value *val = evaluate_subexp (to_type, exp, pos, noside);
3214 if (noside == EVAL_SKIP)
3215 return eval_skip_value (exp);
3216 return value_cast (to_type, val);
3217 }
3218
3219 /* Parse a type expression in the string [P..P+LENGTH). */
3220
3221 struct type *
3222 parse_and_eval_type (char *p, int length)
3223 {
3224 char *tmp = (char *) alloca (length + 4);
3225
3226 tmp[0] = '(';
3227 memcpy (tmp + 1, p, length);
3228 tmp[length + 1] = ')';
3229 tmp[length + 2] = '0';
3230 tmp[length + 3] = '\0';
3231 expression_up expr = parse_expression (tmp);
3232 if (expr->elts[0].opcode != UNOP_CAST)
3233 error (_("Internal error in eval_type."));
3234 return expr->elts[1].type;
3235 }
3236
3237 int
3238 calc_f77_array_dims (struct type *array_type)
3239 {
3240 int ndimen = 1;
3241 struct type *tmp_type;
3242
3243 if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
3244 error (_("Can't get dimensions for a non-array type"));
3245
3246 tmp_type = array_type;
3247
3248 while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3249 {
3250 if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3251 ++ndimen;
3252 }
3253 return ndimen;
3254 }