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