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