arm: Check UNDEFWEAK_NO_DYNAMIC_RELOC
[deliverable/binutils-gdb.git] / gdb / eval.c
CommitLineData
c906108c 1/* Evaluate expressions for GDB.
1bac305b 2
61baf725 3 Copyright (C) 1986-2017 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
708static value *
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
741static value *
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
760static value *
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
1280 case OP_DOUBLE:
1281 (*pos) += 3;
1282 return value_from_double (exp->elts[pc + 1].type,
1283 exp->elts[pc + 2].doubleconst);
1284
27bc4d80
TJB
1285 case OP_DECFLOAT:
1286 (*pos) += 3;
4ef30785
TJB
1287 return value_from_decfloat (exp->elts[pc + 1].type,
1288 exp->elts[pc + 2].decfloatconst);
27bc4d80 1289
7322dca9 1290 case OP_ADL_FUNC:
c906108c
SS
1291 case OP_VAR_VALUE:
1292 (*pos) += 3;
1293 if (noside == EVAL_SKIP)
827d0c51 1294 return eval_skip_value (exp);
46a4882b
PA
1295
1296 {
1297 symbol *var = exp->elts[pc + 2].symbol;
1298 if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ERROR)
1299 error_unknown_type (SYMBOL_PRINT_NAME (var));
1300
1301 return evaluate_var_value (noside, exp->elts[pc + 1].block, var);
1302 }
1303
74ea4be4 1304 case OP_VAR_MSYM_VALUE:
46a4882b
PA
1305 {
1306 (*pos) += 3;
1307
1308 minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
1309 value *val = evaluate_var_msym_value (noside,
1310 exp->elts[pc + 1].objfile,
1311 msymbol);
1312
1313 type = value_type (val);
1314 if (TYPE_CODE (type) == TYPE_CODE_ERROR
1315 && (noside != EVAL_AVOID_SIDE_EFFECTS || pc != 0))
1316 error_unknown_type (MSYMBOL_PRINT_NAME (msymbol));
1317 return val;
1318 }
c906108c 1319
36b11add
JK
1320 case OP_VAR_ENTRY_VALUE:
1321 (*pos) += 2;
1322 if (noside == EVAL_SKIP)
827d0c51 1323 return eval_skip_value (exp);
36b11add
JK
1324
1325 {
1326 struct symbol *sym = exp->elts[pc + 1].symbol;
1327 struct frame_info *frame;
1328
1329 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1330 return value_zero (SYMBOL_TYPE (sym), not_lval);
1331
24d6c2a0 1332 if (SYMBOL_COMPUTED_OPS (sym) == NULL
36b11add
JK
1333 || SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry == NULL)
1334 error (_("Symbol \"%s\" does not have any specific entry value"),
1335 SYMBOL_PRINT_NAME (sym));
1336
1337 frame = get_selected_frame (NULL);
1338 return SYMBOL_COMPUTED_OPS (sym)->read_variable_at_entry (sym, frame);
1339 }
1340
858be34c
PA
1341 case OP_FUNC_STATIC_VAR:
1342 tem = longest_to_int (exp->elts[pc + 1].longconst);
1343 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1344 if (noside == EVAL_SKIP)
1345 return eval_skip_value (exp);
1346
1347 {
1348 value *func = evaluate_subexp_standard (NULL, exp, pos, noside);
1349 CORE_ADDR addr = value_address (func);
1350
1351 const block *blk = block_for_pc (addr);
1352 const char *var = &exp->elts[pc + 2].string;
1353
1354 struct block_symbol sym = lookup_symbol (var, blk, VAR_DOMAIN, NULL);
1355
1356 if (sym.symbol == NULL)
1357 error (_("No symbol \"%s\" in specified context."), var);
1358
1359 return evaluate_var_value (noside, sym.block, sym.symbol);
1360 }
1361
c906108c
SS
1362 case OP_LAST:
1363 (*pos) += 2;
1364 return
1365 access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
1366
1367 case OP_REGISTER:
1368 {
67f3407f
DJ
1369 const char *name = &exp->elts[pc + 2].string;
1370 int regno;
123dc839 1371 struct value *val;
67f3407f
DJ
1372
1373 (*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
d80b854b 1374 regno = user_reg_map_name_to_regnum (exp->gdbarch,
029a67e4 1375 name, strlen (name));
67f3407f
DJ
1376 if (regno == -1)
1377 error (_("Register $%s not available."), name);
80f064a2
JB
1378
1379 /* In EVAL_AVOID_SIDE_EFFECTS mode, we only need to return
1380 a value with the appropriate register type. Unfortunately,
1381 we don't have easy access to the type of user registers.
1382 So for these registers, we fetch the register value regardless
1383 of the evaluation mode. */
1384 if (noside == EVAL_AVOID_SIDE_EFFECTS
d80b854b
UW
1385 && regno < gdbarch_num_regs (exp->gdbarch)
1386 + gdbarch_num_pseudo_regs (exp->gdbarch))
1387 val = value_zero (register_type (exp->gdbarch, regno), not_lval);
123dc839
DJ
1388 else
1389 val = value_of_register (regno, get_selected_frame (NULL));
c906108c 1390 if (val == NULL)
67f3407f 1391 error (_("Value of register %s not available."), name);
c906108c
SS
1392 else
1393 return val;
1394 }
1395 case OP_BOOL:
1396 (*pos) += 2;
fbb06eb1
UW
1397 type = language_bool_type (exp->language_defn, exp->gdbarch);
1398 return value_from_longest (type, exp->elts[pc + 1].longconst);
c906108c
SS
1399
1400 case OP_INTERNALVAR:
1401 (*pos) += 2;
78267919
UW
1402 return value_of_internalvar (exp->gdbarch,
1403 exp->elts[pc + 1].internalvar);
c906108c
SS
1404
1405 case OP_STRING:
1406 tem = longest_to_int (exp->elts[pc + 1].longconst);
1407 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1408 if (noside == EVAL_SKIP)
827d0c51 1409 return eval_skip_value (exp);
3b7538c0
UW
1410 type = language_string_char_type (exp->language_defn, exp->gdbarch);
1411 return value_string (&exp->elts[pc + 2].string, tem, type);
c906108c 1412
3e43a32a
MS
1413 case OP_OBJC_NSSTRING: /* Objective C Foundation Class
1414 NSString constant. */
a9fa03de
AF
1415 tem = longest_to_int (exp->elts[pc + 1].longconst);
1416 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1417 if (noside == EVAL_SKIP)
827d0c51 1418 return eval_skip_value (exp);
3b7538c0 1419 return value_nsstring (exp->gdbarch, &exp->elts[pc + 2].string, tem + 1);
a9fa03de 1420
c906108c
SS
1421 case OP_ARRAY:
1422 (*pos) += 3;
1423 tem2 = longest_to_int (exp->elts[pc + 1].longconst);
1424 tem3 = longest_to_int (exp->elts[pc + 2].longconst);
1425 nargs = tem3 - tem2 + 1;
1426 type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
1427
1428 if (expect_type != NULL_TYPE && noside != EVAL_SKIP
1429 && TYPE_CODE (type) == TYPE_CODE_STRUCT)
1430 {
61051030 1431 struct value *rec = allocate_value (expect_type);
d7f9d729 1432
990a07ab 1433 memset (value_contents_raw (rec), '\0', TYPE_LENGTH (type));
c906108c
SS
1434 return evaluate_struct_tuple (rec, exp, pos, noside, nargs);
1435 }
1436
1437 if (expect_type != NULL_TYPE && noside != EVAL_SKIP
1438 && TYPE_CODE (type) == TYPE_CODE_ARRAY)
1439 {
262452ec 1440 struct type *range_type = TYPE_INDEX_TYPE (type);
c906108c 1441 struct type *element_type = TYPE_TARGET_TYPE (type);
61051030 1442 struct value *array = allocate_value (expect_type);
c906108c
SS
1443 int element_size = TYPE_LENGTH (check_typedef (element_type));
1444 LONGEST low_bound, high_bound, index;
d7f9d729 1445
c906108c
SS
1446 if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
1447 {
1448 low_bound = 0;
1449 high_bound = (TYPE_LENGTH (type) / element_size) - 1;
1450 }
1451 index = low_bound;
990a07ab 1452 memset (value_contents_raw (array), 0, TYPE_LENGTH (expect_type));
c5aa993b 1453 for (tem = nargs; --nargs >= 0;)
c906108c 1454 {
61051030 1455 struct value *element;
c906108c 1456 int index_pc = 0;
d7f9d729 1457
c906108c 1458 element = evaluate_subexp (element_type, exp, pos, noside);
df407dfe 1459 if (value_type (element) != element_type)
c906108c
SS
1460 element = value_cast (element_type, element);
1461 if (index_pc)
1462 {
1463 int continue_pc = *pos;
d7f9d729 1464
c906108c
SS
1465 *pos = index_pc;
1466 index = init_array_element (array, element, exp, pos, noside,
1467 low_bound, high_bound);
1468 *pos = continue_pc;
1469 }
1470 else
1471 {
1472 if (index > high_bound)
0963b4bd 1473 /* To avoid memory corruption. */
8a3fe4f8 1474 error (_("Too many array elements"));
990a07ab 1475 memcpy (value_contents_raw (array)
c906108c 1476 + (index - low_bound) * element_size,
0fd88904 1477 value_contents (element),
c906108c
SS
1478 element_size);
1479 }
1480 index++;
1481 }
1482 return array;
1483 }
1484
1485 if (expect_type != NULL_TYPE && noside != EVAL_SKIP
1486 && TYPE_CODE (type) == TYPE_CODE_SET)
1487 {
61051030 1488 struct value *set = allocate_value (expect_type);
47b667de 1489 gdb_byte *valaddr = value_contents_raw (set);
c906108c
SS
1490 struct type *element_type = TYPE_INDEX_TYPE (type);
1491 struct type *check_type = element_type;
1492 LONGEST low_bound, high_bound;
1493
0963b4bd 1494 /* Get targettype of elementtype. */
905e0470
PM
1495 while (TYPE_CODE (check_type) == TYPE_CODE_RANGE
1496 || TYPE_CODE (check_type) == TYPE_CODE_TYPEDEF)
c906108c
SS
1497 check_type = TYPE_TARGET_TYPE (check_type);
1498
1499 if (get_discrete_bounds (element_type, &low_bound, &high_bound) < 0)
8a3fe4f8 1500 error (_("(power)set type with unknown size"));
c906108c
SS
1501 memset (valaddr, '\0', TYPE_LENGTH (type));
1502 for (tem = 0; tem < nargs; tem++)
1503 {
1504 LONGEST range_low, range_high;
1505 struct type *range_low_type, *range_high_type;
61051030 1506 struct value *elem_val;
d7f9d729 1507
ae8fddda
YQ
1508 elem_val = evaluate_subexp (element_type, exp, pos, noside);
1509 range_low_type = range_high_type = value_type (elem_val);
1510 range_low = range_high = value_as_long (elem_val);
1511
0963b4bd 1512 /* Check types of elements to avoid mixture of elements from
c5aa993b 1513 different types. Also check if type of element is "compatible"
0963b4bd 1514 with element type of powerset. */
c906108c
SS
1515 if (TYPE_CODE (range_low_type) == TYPE_CODE_RANGE)
1516 range_low_type = TYPE_TARGET_TYPE (range_low_type);
1517 if (TYPE_CODE (range_high_type) == TYPE_CODE_RANGE)
1518 range_high_type = TYPE_TARGET_TYPE (range_high_type);
905e0470
PM
1519 if ((TYPE_CODE (range_low_type) != TYPE_CODE (range_high_type))
1520 || (TYPE_CODE (range_low_type) == TYPE_CODE_ENUM
1521 && (range_low_type != range_high_type)))
0963b4bd 1522 /* different element modes. */
8a3fe4f8 1523 error (_("POWERSET tuple elements of different mode"));
905e0470
PM
1524 if ((TYPE_CODE (check_type) != TYPE_CODE (range_low_type))
1525 || (TYPE_CODE (check_type) == TYPE_CODE_ENUM
1526 && range_low_type != check_type))
8a3fe4f8 1527 error (_("incompatible POWERSET tuple elements"));
c906108c
SS
1528 if (range_low > range_high)
1529 {
8a3fe4f8 1530 warning (_("empty POWERSET tuple range"));
c906108c
SS
1531 continue;
1532 }
1533 if (range_low < low_bound || range_high > high_bound)
8a3fe4f8 1534 error (_("POWERSET tuple element out of range"));
c906108c
SS
1535 range_low -= low_bound;
1536 range_high -= low_bound;
c5aa993b 1537 for (; range_low <= range_high; range_low++)
c906108c
SS
1538 {
1539 int bit_index = (unsigned) range_low % TARGET_CHAR_BIT;
d7f9d729 1540
34e13b5b 1541 if (gdbarch_bits_big_endian (exp->gdbarch))
c906108c 1542 bit_index = TARGET_CHAR_BIT - 1 - bit_index;
c5aa993b 1543 valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
c906108c
SS
1544 |= 1 << bit_index;
1545 }
1546 }
1547 return set;
1548 }
1549
8d749320 1550 argvec = XALLOCAVEC (struct value *, nargs);
c906108c
SS
1551 for (tem = 0; tem < nargs; tem++)
1552 {
0963b4bd
MS
1553 /* Ensure that array expressions are coerced into pointer
1554 objects. */
c906108c
SS
1555 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1556 }
1557 if (noside == EVAL_SKIP)
827d0c51 1558 return eval_skip_value (exp);
c906108c
SS
1559 return value_array (tem2, tem3, argvec);
1560
1561 case TERNOP_SLICE:
1562 {
61051030 1563 struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
c906108c 1564 int lowbound
d7f9d729 1565 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
c906108c 1566 int upper
d7f9d729
MS
1567 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1568
c906108c 1569 if (noside == EVAL_SKIP)
827d0c51 1570 return eval_skip_value (exp);
c906108c
SS
1571 return value_slice (array, lowbound, upper - lowbound + 1);
1572 }
1573
c906108c
SS
1574 case TERNOP_COND:
1575 /* Skip third and second args to evaluate the first one. */
1576 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1577 if (value_logical_not (arg1))
1578 {
1579 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1580 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1581 }
1582 else
1583 {
1584 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1585 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1586 return arg2;
1587 }
1588
a9fa03de
AF
1589 case OP_OBJC_SELECTOR:
1590 { /* Objective C @selector operator. */
1591 char *sel = &exp->elts[pc + 2].string;
1592 int len = longest_to_int (exp->elts[pc + 1].longconst);
d4dbb9c7 1593 struct type *selector_type;
a9fa03de
AF
1594
1595 (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
1596 if (noside == EVAL_SKIP)
827d0c51 1597 return eval_skip_value (exp);
a9fa03de
AF
1598
1599 if (sel[len] != 0)
1600 sel[len] = 0; /* Make sure it's terminated. */
d4dbb9c7
UW
1601
1602 selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
3b7538c0
UW
1603 return value_from_longest (selector_type,
1604 lookup_child_selector (exp->gdbarch, sel));
a9fa03de
AF
1605 }
1606
1607 case OP_OBJC_MSGCALL:
1608 { /* Objective C message (method) call. */
1609
17dd65ce
TT
1610 CORE_ADDR responds_selector = 0;
1611 CORE_ADDR method_selector = 0;
a9fa03de 1612
c253954e 1613 CORE_ADDR selector = 0;
a9fa03de 1614
a9fa03de 1615 int struct_return = 0;
f486487f 1616 enum noside sub_no_side = EVAL_NORMAL;
a9fa03de 1617
17dd65ce
TT
1618 struct value *msg_send = NULL;
1619 struct value *msg_send_stret = NULL;
1620 int gnu_runtime = 0;
a9fa03de
AF
1621
1622 struct value *target = NULL;
1623 struct value *method = NULL;
1624 struct value *called_method = NULL;
1625
1626 struct type *selector_type = NULL;
d4dbb9c7 1627 struct type *long_type;
a9fa03de
AF
1628
1629 struct value *ret = NULL;
1630 CORE_ADDR addr = 0;
1631
1632 selector = exp->elts[pc + 1].longconst;
1633 nargs = exp->elts[pc + 2].longconst;
8d749320 1634 argvec = XALLOCAVEC (struct value *, nargs + 5);
a9fa03de
AF
1635
1636 (*pos) += 3;
1637
d4dbb9c7
UW
1638 long_type = builtin_type (exp->gdbarch)->builtin_long;
1639 selector_type = builtin_type (exp->gdbarch)->builtin_data_ptr;
1640
a9fa03de
AF
1641 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1642 sub_no_side = EVAL_NORMAL;
1643 else
1644 sub_no_side = noside;
1645
1646 target = evaluate_subexp (selector_type, exp, pos, sub_no_side);
1647
1648 if (value_as_long (target) == 0)
d4dbb9c7 1649 return value_from_longest (long_type, 0);
a9fa03de 1650
3b7344d5 1651 if (lookup_minimal_symbol ("objc_msg_lookup", 0, 0).minsym)
a9fa03de
AF
1652 gnu_runtime = 1;
1653
1654 /* Find the method dispatch (Apple runtime) or method lookup
1655 (GNU runtime) function for Objective-C. These will be used
1656 to lookup the symbol information for the method. If we
1657 can't find any symbol information, then we'll use these to
1658 call the method, otherwise we can call the method
0963b4bd 1659 directly. The msg_send_stret function is used in the special
a9fa03de
AF
1660 case of a method that returns a structure (Apple runtime
1661 only). */
1662 if (gnu_runtime)
1663 {
d4dbb9c7 1664 struct type *type = selector_type;
d7f9d729 1665
c253954e
JB
1666 type = lookup_function_type (type);
1667 type = lookup_pointer_type (type);
1668 type = lookup_function_type (type);
1669 type = lookup_pointer_type (type);
1670
3e3b026f
UW
1671 msg_send = find_function_in_inferior ("objc_msg_lookup", NULL);
1672 msg_send_stret
1673 = find_function_in_inferior ("objc_msg_lookup", NULL);
c253954e
JB
1674
1675 msg_send = value_from_pointer (type, value_as_address (msg_send));
1676 msg_send_stret = value_from_pointer (type,
1677 value_as_address (msg_send_stret));
a9fa03de
AF
1678 }
1679 else
1680 {
3e3b026f 1681 msg_send = find_function_in_inferior ("objc_msgSend", NULL);
0963b4bd 1682 /* Special dispatcher for methods returning structs. */
3e3b026f
UW
1683 msg_send_stret
1684 = find_function_in_inferior ("objc_msgSend_stret", NULL);
a9fa03de
AF
1685 }
1686
0963b4bd 1687 /* Verify the target object responds to this method. The
a9fa03de
AF
1688 standard top-level 'Object' class uses a different name for
1689 the verification method than the non-standard, but more
0963b4bd 1690 often used, 'NSObject' class. Make sure we check for both. */
a9fa03de 1691
3b7538c0
UW
1692 responds_selector
1693 = lookup_child_selector (exp->gdbarch, "respondsToSelector:");
a9fa03de 1694 if (responds_selector == 0)
3b7538c0
UW
1695 responds_selector
1696 = lookup_child_selector (exp->gdbarch, "respondsTo:");
a9fa03de
AF
1697
1698 if (responds_selector == 0)
8a3fe4f8 1699 error (_("no 'respondsTo:' or 'respondsToSelector:' method"));
a9fa03de 1700
3b7538c0
UW
1701 method_selector
1702 = lookup_child_selector (exp->gdbarch, "methodForSelector:");
a9fa03de 1703 if (method_selector == 0)
3b7538c0
UW
1704 method_selector
1705 = lookup_child_selector (exp->gdbarch, "methodFor:");
a9fa03de
AF
1706
1707 if (method_selector == 0)
8a3fe4f8 1708 error (_("no 'methodFor:' or 'methodForSelector:' method"));
a9fa03de
AF
1709
1710 /* Call the verification method, to make sure that the target
0963b4bd 1711 class implements the desired method. */
a9fa03de
AF
1712
1713 argvec[0] = msg_send;
1714 argvec[1] = target;
d4dbb9c7
UW
1715 argvec[2] = value_from_longest (long_type, responds_selector);
1716 argvec[3] = value_from_longest (long_type, selector);
a9fa03de
AF
1717 argvec[4] = 0;
1718
7022349d 1719 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
a9fa03de
AF
1720 if (gnu_runtime)
1721 {
1722 /* Function objc_msg_lookup returns a pointer. */
1723 argvec[0] = ret;
7022349d 1724 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
a9fa03de
AF
1725 }
1726 if (value_as_long (ret) == 0)
8a3fe4f8 1727 error (_("Target does not respond to this message selector."));
a9fa03de
AF
1728
1729 /* Call "methodForSelector:" method, to get the address of a
1730 function method that implements this selector for this
1731 class. If we can find a symbol at that address, then we
1732 know the return type, parameter types etc. (that's a good
0963b4bd 1733 thing). */
a9fa03de
AF
1734
1735 argvec[0] = msg_send;
1736 argvec[1] = target;
d4dbb9c7
UW
1737 argvec[2] = value_from_longest (long_type, method_selector);
1738 argvec[3] = value_from_longest (long_type, selector);
a9fa03de
AF
1739 argvec[4] = 0;
1740
7022349d 1741 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
a9fa03de
AF
1742 if (gnu_runtime)
1743 {
1744 argvec[0] = ret;
7022349d 1745 ret = call_function_by_hand (argvec[0], NULL, 3, argvec + 1);
a9fa03de
AF
1746 }
1747
1748 /* ret should now be the selector. */
1749
1750 addr = value_as_long (ret);
1751 if (addr)
1752 {
1753 struct symbol *sym = NULL;
a9fa03de 1754
69368a60
UW
1755 /* The address might point to a function descriptor;
1756 resolve it to the actual code address instead. */
1757 addr = gdbarch_convert_from_func_ptr_addr (exp->gdbarch, addr,
1758 &current_target);
1759
1760 /* Is it a high_level symbol? */
a9fa03de
AF
1761 sym = find_pc_function (addr);
1762 if (sym != NULL)
1763 method = value_of_variable (sym, 0);
1764 }
1765
1766 /* If we found a method with symbol information, check to see
1767 if it returns a struct. Otherwise assume it doesn't. */
1768
1769 if (method)
1770 {
a9fa03de 1771 CORE_ADDR funaddr;
c055b101 1772 struct type *val_type;
a9fa03de 1773
c055b101 1774 funaddr = find_function_addr (method, &val_type);
a9fa03de 1775
262acaeb 1776 block_for_pc (funaddr);
a9fa03de 1777
f168693b 1778 val_type = check_typedef (val_type);
a9fa03de 1779
c055b101
CV
1780 if ((val_type == NULL)
1781 || (TYPE_CODE(val_type) == TYPE_CODE_ERROR))
a9fa03de
AF
1782 {
1783 if (expect_type != NULL)
c055b101 1784 val_type = expect_type;
a9fa03de
AF
1785 }
1786
6a3a010b 1787 struct_return = using_struct_return (exp->gdbarch, method,
3e43a32a 1788 val_type);
a9fa03de
AF
1789 }
1790 else if (expect_type != NULL)
1791 {
d80b854b 1792 struct_return = using_struct_return (exp->gdbarch, NULL,
c055b101 1793 check_typedef (expect_type));
a9fa03de
AF
1794 }
1795
1796 /* Found a function symbol. Now we will substitute its
1797 value in place of the message dispatcher (obj_msgSend),
1798 so that we call the method directly instead of thru
1799 the dispatcher. The main reason for doing this is that
1800 we can now evaluate the return value and parameter values
1801 according to their known data types, in case we need to
1802 do things like promotion, dereferencing, special handling
1803 of structs and doubles, etc.
1804
1805 We want to use the type signature of 'method', but still
1806 jump to objc_msgSend() or objc_msgSend_stret() to better
1807 mimic the behavior of the runtime. */
1808
1809 if (method)
1810 {
df407dfe 1811 if (TYPE_CODE (value_type (method)) != TYPE_CODE_FUNC)
3e43a32a
MS
1812 error (_("method address has symbol information "
1813 "with non-function type; skipping"));
1814
1815 /* Create a function pointer of the appropriate type, and
1816 replace its value with the value of msg_send or
1817 msg_send_stret. We must use a pointer here, as
1818 msg_send and msg_send_stret are of pointer type, and
1819 the representation may be different on systems that use
69368a60 1820 function descriptors. */
a9fa03de 1821 if (struct_return)
69368a60
UW
1822 called_method
1823 = value_from_pointer (lookup_pointer_type (value_type (method)),
1824 value_as_address (msg_send_stret));
a9fa03de 1825 else
69368a60
UW
1826 called_method
1827 = value_from_pointer (lookup_pointer_type (value_type (method)),
1828 value_as_address (msg_send));
a9fa03de
AF
1829 }
1830 else
1831 {
1832 if (struct_return)
1833 called_method = msg_send_stret;
1834 else
1835 called_method = msg_send;
1836 }
1837
1838 if (noside == EVAL_SKIP)
827d0c51 1839 return eval_skip_value (exp);
a9fa03de
AF
1840
1841 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1842 {
1843 /* If the return type doesn't look like a function type,
1844 call an error. This can happen if somebody tries to
0963b4bd 1845 turn a variable into a function call. This is here
a9fa03de
AF
1846 because people often want to call, eg, strcmp, which
1847 gdb doesn't know is a function. If gdb isn't asked for
1848 it's opinion (ie. through "whatis"), it won't offer
0963b4bd 1849 it. */
a9fa03de 1850
df407dfe 1851 struct type *type = value_type (called_method);
d7f9d729 1852
a9fa03de
AF
1853 if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
1854 type = TYPE_TARGET_TYPE (type);
1855 type = TYPE_TARGET_TYPE (type);
1856
1857 if (type)
1858 {
1859 if ((TYPE_CODE (type) == TYPE_CODE_ERROR) && expect_type)
1860 return allocate_value (expect_type);
1861 else
1862 return allocate_value (type);
1863 }
1864 else
3e43a32a
MS
1865 error (_("Expression of type other than "
1866 "\"method returning ...\" used as a method"));
a9fa03de
AF
1867 }
1868
1869 /* Now depending on whether we found a symbol for the method,
1870 we will either call the runtime dispatcher or the method
1871 directly. */
1872
1873 argvec[0] = called_method;
1874 argvec[1] = target;
d4dbb9c7 1875 argvec[2] = value_from_longest (long_type, selector);
a9fa03de
AF
1876 /* User-supplied arguments. */
1877 for (tem = 0; tem < nargs; tem++)
1878 argvec[tem + 3] = evaluate_subexp_with_coercion (exp, pos, noside);
1879 argvec[tem + 3] = 0;
1880
1881 if (gnu_runtime && (method != NULL))
1882 {
a9fa03de 1883 /* Function objc_msg_lookup returns a pointer. */
04624583 1884 deprecated_set_value_type (argvec[0],
69368a60 1885 lookup_pointer_type (lookup_function_type (value_type (argvec[0]))));
3e43a32a 1886 argvec[0]
7022349d 1887 = call_function_by_hand (argvec[0], NULL, nargs + 2, argvec + 1);
a9fa03de 1888 }
a9fa03de 1889
7022349d 1890 ret = call_function_by_hand (argvec[0], NULL, nargs + 2, argvec + 1);
a9fa03de
AF
1891 return ret;
1892 }
1893 break;
1894
c906108c 1895 case OP_FUNCALL:
e69570ee 1896 return evaluate_funcall (expect_type, exp, pos, noside);
c906108c 1897
c5aa993b 1898 case OP_F77_UNDETERMINED_ARGLIST:
c906108c
SS
1899
1900 /* Remember that in F77, functions, substring ops and
1901 array subscript operations cannot be disambiguated
1902 at parse time. We have made all array subscript operations,
1903 substring operations as well as function calls come here
0963b4bd
MS
1904 and we now have to discover what the heck this thing actually was.
1905 If it is a function, we process just as if we got an OP_FUNCALL. */
c906108c 1906
c5aa993b 1907 nargs = longest_to_int (exp->elts[pc + 1].longconst);
c906108c
SS
1908 (*pos) += 2;
1909
c5aa993b 1910 /* First determine the type code we are dealing with. */
c906108c 1911 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 1912 type = check_typedef (value_type (arg1));
c906108c
SS
1913 code = TYPE_CODE (type);
1914
df0ca547
WZ
1915 if (code == TYPE_CODE_PTR)
1916 {
1917 /* Fortran always passes variable to subroutines as pointer.
1918 So we need to look into its target type to see if it is
1919 array, string or function. If it is, we need to switch
1920 to the target value the original one points to. */
1921 struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
1922
1923 if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY
1924 || TYPE_CODE (target_type) == TYPE_CODE_STRING
1925 || TYPE_CODE (target_type) == TYPE_CODE_FUNC)
1926 {
1927 arg1 = value_ind (arg1);
1928 type = check_typedef (value_type (arg1));
1929 code = TYPE_CODE (type);
1930 }
1931 }
1932
c5aa993b 1933 switch (code)
c906108c
SS
1934 {
1935 case TYPE_CODE_ARRAY:
01739a3b 1936 if (exp->elts[*pos].opcode == OP_RANGE)
0b4e1325
WZ
1937 return value_f90_subarray (arg1, exp, pos, noside);
1938 else
1939 goto multi_f77_subscript;
c906108c
SS
1940
1941 case TYPE_CODE_STRING:
01739a3b 1942 if (exp->elts[*pos].opcode == OP_RANGE)
0b4e1325
WZ
1943 return value_f90_subarray (arg1, exp, pos, noside);
1944 else
1945 {
1946 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2497b498 1947 return value_subscript (arg1, value_as_long (arg2));
0b4e1325 1948 }
c906108c
SS
1949
1950 case TYPE_CODE_PTR:
1951 case TYPE_CODE_FUNC:
0963b4bd 1952 /* It's a function call. */
c906108c 1953 /* Allocate arg vector, including space for the function to be
0963b4bd 1954 called in argvec[0] and a terminating NULL. */
3e43a32a
MS
1955 argvec = (struct value **)
1956 alloca (sizeof (struct value *) * (nargs + 2));
c906108c
SS
1957 argvec[0] = arg1;
1958 tem = 1;
1959 for (; tem <= nargs; tem++)
1960 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
c5aa993b 1961 argvec[tem] = 0; /* signal end of arglist */
b1f28d99 1962 if (noside == EVAL_SKIP)
827d0c51 1963 return eval_skip_value (exp);
e69570ee 1964 return eval_call (exp, noside, nargs, argvec, NULL, expect_type);
c906108c
SS
1965
1966 default:
8a3fe4f8 1967 error (_("Cannot perform substring on this type"));
c906108c
SS
1968 }
1969
c906108c
SS
1970 case OP_COMPLEX:
1971 /* We have a complex number, There should be 2 floating
0963b4bd 1972 point numbers that compose it. */
c806c55a 1973 (*pos) += 2;
c906108c 1974 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
c5aa993b 1975 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
c906108c 1976
c806c55a 1977 return value_literal_complex (arg1, arg2, exp->elts[pc + 1].type);
c906108c
SS
1978
1979 case STRUCTOP_STRUCT:
1980 tem = longest_to_int (exp->elts[pc + 1].longconst);
1981 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1982 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1983 if (noside == EVAL_SKIP)
827d0c51 1984 return eval_skip_value (exp);
ac1ca910 1985 arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
fce632b6 1986 NULL, "structure");
ac1ca910 1987 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2520f728 1988 arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
ac1ca910 1989 return arg3;
c906108c
SS
1990
1991 case STRUCTOP_PTR:
1992 tem = longest_to_int (exp->elts[pc + 1].longconst);
1993 (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1994 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1995 if (noside == EVAL_SKIP)
827d0c51 1996 return eval_skip_value (exp);
070ad9f0 1997
79afc5ef
SW
1998 /* Check to see if operator '->' has been overloaded. If so replace
1999 arg1 with the value returned by evaluating operator->(). */
2000 while (unop_user_defined_p (op, arg1))
2001 {
79afc5ef 2002 struct value *value = NULL;
492d29ea 2003 TRY
79afc5ef
SW
2004 {
2005 value = value_x_unop (arg1, op, noside);
2006 }
2007
492d29ea 2008 CATCH (except, RETURN_MASK_ERROR)
79afc5ef
SW
2009 {
2010 if (except.error == NOT_FOUND_ERROR)
2011 break;
2012 else
2013 throw_exception (except);
2014 }
492d29ea
PA
2015 END_CATCH
2016
79afc5ef
SW
2017 arg1 = value;
2018 }
2019
070ad9f0
DB
2020 /* JYG: if print object is on we need to replace the base type
2021 with rtti type in order to continue on with successful
0963b4bd 2022 lookup of member / method only available in the rtti type. */
070ad9f0 2023 {
df407dfe 2024 struct type *type = value_type (arg1);
070ad9f0 2025 struct type *real_type;
6b850546
DT
2026 int full, using_enc;
2027 LONGEST top;
79a45b7d
TT
2028 struct value_print_options opts;
2029
2030 get_user_print_options (&opts);
905e0470 2031 if (opts.objectprint && TYPE_TARGET_TYPE(type)
4753d33b 2032 && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRUCT))
070ad9f0 2033 {
dfcee124
AG
2034 real_type = value_rtti_indirect_type (arg1, &full, &top,
2035 &using_enc);
070ad9f0 2036 if (real_type)
070ad9f0 2037 arg1 = value_cast (real_type, arg1);
070ad9f0
DB
2038 }
2039 }
2040
ac1ca910 2041 arg3 = value_struct_elt (&arg1, NULL, &exp->elts[pc + 2].string,
fce632b6 2042 NULL, "structure pointer");
ac1ca910 2043 if (noside == EVAL_AVOID_SIDE_EFFECTS)
ac775bf4 2044 arg3 = value_zero (value_type (arg3), VALUE_LVAL (arg3));
ac1ca910 2045 return arg3;
c906108c
SS
2046
2047 case STRUCTOP_MEMBER:
0d5de010
DJ
2048 case STRUCTOP_MPTR:
2049 if (op == STRUCTOP_MEMBER)
2050 arg1 = evaluate_subexp_for_address (exp, pos, noside);
2051 else
2052 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2053
c906108c
SS
2054 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2055
0d5de010 2056 if (noside == EVAL_SKIP)
827d0c51 2057 return eval_skip_value (exp);
c5aa993b 2058
0d5de010
DJ
2059 type = check_typedef (value_type (arg2));
2060 switch (TYPE_CODE (type))
2061 {
2062 case TYPE_CODE_METHODPTR:
0d5de010
DJ
2063 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2064 return value_zero (TYPE_TARGET_TYPE (type), not_lval);
2065 else
2066 {
2067 arg2 = cplus_method_ptr_to_value (&arg1, arg2);
2068 gdb_assert (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR);
2069 return value_ind (arg2);
2070 }
c906108c 2071
0d5de010
DJ
2072 case TYPE_CODE_MEMBERPTR:
2073 /* Now, convert these values to an address. */
4bfb94b8 2074 arg1 = value_cast_pointers (lookup_pointer_type (TYPE_SELF_TYPE (type)),
b1af9e97 2075 arg1, 1);
c906108c 2076
0d5de010 2077 mem_offset = value_as_long (arg2);
c906108c 2078
0d5de010
DJ
2079 arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
2080 value_as_long (arg1) + mem_offset);
2081 return value_ind (arg3);
2082
2083 default:
3e43a32a
MS
2084 error (_("non-pointer-to-member value used "
2085 "in pointer-to-member construct"));
c5aa993b 2086 }
c906108c 2087
072bba3b 2088 case TYPE_INSTANCE:
3693fdb3
PA
2089 {
2090 type_instance_flags flags
2091 = (type_instance_flag_value) longest_to_int (exp->elts[pc + 1].longconst);
2092 nargs = longest_to_int (exp->elts[pc + 2].longconst);
2093 arg_types = (struct type **) alloca (nargs * sizeof (struct type *));
2094 for (ix = 0; ix < nargs; ++ix)
2095 arg_types[ix] = exp->elts[pc + 2 + ix + 1].type;
2096
c83833f4 2097 fake_method expect_type (flags, nargs, arg_types);
3693fdb3 2098 *(pos) += 4 + nargs;
c83833f4 2099 return evaluate_subexp_standard (expect_type.type (), exp, pos, noside);
3693fdb3 2100 }
072bba3b 2101
c906108c
SS
2102 case BINOP_CONCAT:
2103 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2104 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2105 if (noside == EVAL_SKIP)
827d0c51 2106 return eval_skip_value (exp);
c906108c
SS
2107 if (binop_user_defined_p (op, arg1, arg2))
2108 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2109 else
2110 return value_concat (arg1, arg2);
2111
2112 case BINOP_ASSIGN:
2113 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2114 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c 2115
c906108c
SS
2116 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2117 return arg1;
2118 if (binop_user_defined_p (op, arg1, arg2))
2119 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2120 else
2121 return value_assign (arg1, arg2);
2122
2123 case BINOP_ASSIGN_MODIFY:
2124 (*pos) += 2;
2125 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2126 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c
SS
2127 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2128 return arg1;
2129 op = exp->elts[pc + 1].opcode;
2130 if (binop_user_defined_p (op, arg1, arg2))
2131 return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op, noside);
cc73bb8c
TT
2132 else if (op == BINOP_ADD && ptrmath_type_p (exp->language_defn,
2133 value_type (arg1))
2497b498
UW
2134 && is_integral_type (value_type (arg2)))
2135 arg2 = value_ptradd (arg1, value_as_long (arg2));
cc73bb8c
TT
2136 else if (op == BINOP_SUB && ptrmath_type_p (exp->language_defn,
2137 value_type (arg1))
2497b498
UW
2138 && is_integral_type (value_type (arg2)))
2139 arg2 = value_ptradd (arg1, - value_as_long (arg2));
c906108c 2140 else
f44316fa
UW
2141 {
2142 struct value *tmp = arg1;
2143
2144 /* For shift and integer exponentiation operations,
2145 only promote the first argument. */
2146 if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2147 && is_integral_type (value_type (arg2)))
2148 unop_promote (exp->language_defn, exp->gdbarch, &tmp);
2149 else
2150 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2151
2152 arg2 = value_binop (tmp, arg2, op);
2153 }
c906108c
SS
2154 return value_assign (arg1, arg2);
2155
2156 case BINOP_ADD:
2157 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2158 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2159 if (noside == EVAL_SKIP)
827d0c51 2160 return eval_skip_value (exp);
c906108c
SS
2161 if (binop_user_defined_p (op, arg1, arg2))
2162 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
cc73bb8c 2163 else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2497b498
UW
2164 && is_integral_type (value_type (arg2)))
2165 return value_ptradd (arg1, value_as_long (arg2));
cc73bb8c 2166 else if (ptrmath_type_p (exp->language_defn, value_type (arg2))
2497b498
UW
2167 && is_integral_type (value_type (arg1)))
2168 return value_ptradd (arg2, value_as_long (arg1));
c906108c 2169 else
f44316fa
UW
2170 {
2171 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2172 return value_binop (arg1, arg2, BINOP_ADD);
2173 }
c906108c
SS
2174
2175 case BINOP_SUB:
2176 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2177 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2178 if (noside == EVAL_SKIP)
827d0c51 2179 return eval_skip_value (exp);
c906108c
SS
2180 if (binop_user_defined_p (op, arg1, arg2))
2181 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
cc73bb8c
TT
2182 else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2183 && ptrmath_type_p (exp->language_defn, value_type (arg2)))
89eef114 2184 {
2497b498
UW
2185 /* FIXME -- should be ptrdiff_t */
2186 type = builtin_type (exp->gdbarch)->builtin_long;
2187 return value_from_longest (type, value_ptrdiff (arg1, arg2));
89eef114 2188 }
cc73bb8c 2189 else if (ptrmath_type_p (exp->language_defn, value_type (arg1))
2497b498
UW
2190 && is_integral_type (value_type (arg2)))
2191 return value_ptradd (arg1, - value_as_long (arg2));
c906108c 2192 else
f44316fa
UW
2193 {
2194 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2195 return value_binop (arg1, arg2, BINOP_SUB);
2196 }
c906108c 2197
bd49c137 2198 case BINOP_EXP:
c906108c
SS
2199 case BINOP_MUL:
2200 case BINOP_DIV:
9b3442ee 2201 case BINOP_INTDIV:
c906108c
SS
2202 case BINOP_REM:
2203 case BINOP_MOD:
2204 case BINOP_LSH:
2205 case BINOP_RSH:
2206 case BINOP_BITWISE_AND:
2207 case BINOP_BITWISE_IOR:
2208 case BINOP_BITWISE_XOR:
2209 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2210 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2211 if (noside == EVAL_SKIP)
827d0c51 2212 return eval_skip_value (exp);
c906108c
SS
2213 if (binop_user_defined_p (op, arg1, arg2))
2214 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
c906108c 2215 else
301f0ecf
DE
2216 {
2217 /* If EVAL_AVOID_SIDE_EFFECTS and we're dividing by zero,
2218 fudge arg2 to avoid division-by-zero, the caller is
2219 (theoretically) only looking for the type of the result. */
2220 if (noside == EVAL_AVOID_SIDE_EFFECTS
2221 /* ??? Do we really want to test for BINOP_MOD here?
2222 The implementation of value_binop gives it a well-defined
2223 value. */
2224 && (op == BINOP_DIV
2225 || op == BINOP_INTDIV
2226 || op == BINOP_REM
2227 || op == BINOP_MOD)
2228 && value_logical_not (arg2))
2229 {
2230 struct value *v_one, *retval;
2231
18a46dbe 2232 v_one = value_one (value_type (arg2));
f44316fa 2233 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &v_one);
301f0ecf
DE
2234 retval = value_binop (arg1, v_one, op);
2235 return retval;
2236 }
2237 else
f44316fa
UW
2238 {
2239 /* For shift and integer exponentiation operations,
2240 only promote the first argument. */
2241 if ((op == BINOP_LSH || op == BINOP_RSH || op == BINOP_EXP)
2242 && is_integral_type (value_type (arg2)))
2243 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2244 else
2245 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
2246
2247 return value_binop (arg1, arg2, op);
2248 }
301f0ecf 2249 }
c906108c 2250
c906108c 2251 case BINOP_SUBSCRIPT:
74de6778
TT
2252 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2253 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
c906108c 2254 if (noside == EVAL_SKIP)
827d0c51 2255 return eval_skip_value (exp);
c906108c
SS
2256 if (binop_user_defined_p (op, arg1, arg2))
2257 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2258 else
c5aa993b 2259 {
c906108c
SS
2260 /* If the user attempts to subscript something that is not an
2261 array or pointer type (like a plain int variable for example),
0963b4bd 2262 then report this as an error. */
c906108c 2263
994b9211 2264 arg1 = coerce_ref (arg1);
df407dfe 2265 type = check_typedef (value_type (arg1));
c906108c
SS
2266 if (TYPE_CODE (type) != TYPE_CODE_ARRAY
2267 && TYPE_CODE (type) != TYPE_CODE_PTR)
2268 {
2269 if (TYPE_NAME (type))
8a3fe4f8 2270 error (_("cannot subscript something of type `%s'"),
c906108c
SS
2271 TYPE_NAME (type));
2272 else
8a3fe4f8 2273 error (_("cannot subscript requested type"));
c906108c
SS
2274 }
2275
2276 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2277 return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
2278 else
2497b498 2279 return value_subscript (arg1, value_as_long (arg2));
c5aa993b 2280 }
c906108c
SS
2281 case MULTI_SUBSCRIPT:
2282 (*pos) += 2;
2283 nargs = longest_to_int (exp->elts[pc + 1].longconst);
2284 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
2285 while (nargs-- > 0)
2286 {
2287 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
0963b4bd 2288 /* FIXME: EVAL_SKIP handling may not be correct. */
c906108c
SS
2289 if (noside == EVAL_SKIP)
2290 {
2291 if (nargs > 0)
827d0c51
PA
2292 continue;
2293 return eval_skip_value (exp);
c906108c 2294 }
0963b4bd 2295 /* FIXME: EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
c906108c
SS
2296 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2297 {
2298 /* If the user attempts to subscript something that has no target
c5aa993b 2299 type (like a plain int variable for example), then report this
0963b4bd 2300 as an error. */
c5aa993b 2301
df407dfe 2302 type = TYPE_TARGET_TYPE (check_typedef (value_type (arg1)));
c906108c
SS
2303 if (type != NULL)
2304 {
2305 arg1 = value_zero (type, VALUE_LVAL (arg1));
2306 noside = EVAL_SKIP;
2307 continue;
2308 }
2309 else
2310 {
8a3fe4f8 2311 error (_("cannot subscript something of type `%s'"),
df407dfe 2312 TYPE_NAME (value_type (arg1)));
c906108c
SS
2313 }
2314 }
c5aa993b 2315
c906108c
SS
2316 if (binop_user_defined_p (op, arg1, arg2))
2317 {
2318 arg1 = value_x_binop (arg1, arg2, op, OP_NULL, noside);
2319 }
2320 else
2321 {
afc05acb
UW
2322 arg1 = coerce_ref (arg1);
2323 type = check_typedef (value_type (arg1));
2324
2325 switch (TYPE_CODE (type))
2326 {
2327 case TYPE_CODE_PTR:
2328 case TYPE_CODE_ARRAY:
2329 case TYPE_CODE_STRING:
2497b498 2330 arg1 = value_subscript (arg1, value_as_long (arg2));
afc05acb
UW
2331 break;
2332
afc05acb
UW
2333 default:
2334 if (TYPE_NAME (type))
2335 error (_("cannot subscript something of type `%s'"),
2336 TYPE_NAME (type));
2337 else
2338 error (_("cannot subscript requested type"));
2339 }
c906108c
SS
2340 }
2341 }
2342 return (arg1);
2343
2344 multi_f77_subscript:
c5aa993b 2345 {
c2ff108b 2346 LONGEST subscript_array[MAX_FORTRAN_DIMS];
c5aa993b 2347 int ndimensions = 1, i;
c2ff108b 2348 struct value *array = arg1;
c906108c
SS
2349
2350 if (nargs > MAX_FORTRAN_DIMS)
8a3fe4f8 2351 error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
c906108c 2352
c906108c
SS
2353 ndimensions = calc_f77_array_dims (type);
2354
2355 if (nargs != ndimensions)
8a3fe4f8 2356 error (_("Wrong number of subscripts"));
c906108c 2357
1c9f699c
DJ
2358 gdb_assert (nargs > 0);
2359
c906108c 2360 /* Now that we know we have a legal array subscript expression
0963b4bd 2361 let us actually find out where this element exists in the array. */
c906108c 2362
0963b4bd 2363 /* Take array indices left to right. */
7ca2d3a3 2364 for (i = 0; i < nargs; i++)
c906108c 2365 {
0963b4bd 2366 /* Evaluate each subscript; it must be a legal integer in F77. */
c906108c
SS
2367 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
2368
c2ff108b 2369 /* Fill in the subscript array. */
c906108c
SS
2370
2371 subscript_array[i] = value_as_long (arg2);
7ca2d3a3 2372 }
c5aa993b 2373
0963b4bd 2374 /* Internal type of array is arranged right to left. */
c2ff108b 2375 for (i = nargs; i > 0; i--)
7ca2d3a3 2376 {
c2ff108b
JK
2377 struct type *array_type = check_typedef (value_type (array));
2378 LONGEST index = subscript_array[i - 1];
c906108c 2379
0953dec1
SP
2380 array = value_subscripted_rvalue (array, index,
2381 f77_get_lowerbound (array_type));
c906108c
SS
2382 }
2383
c2ff108b 2384 return array;
c906108c
SS
2385 }
2386
2387 case BINOP_LOGICAL_AND:
2388 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2389 if (noside == EVAL_SKIP)
2390 {
262acaeb 2391 evaluate_subexp (NULL_TYPE, exp, pos, noside);
827d0c51 2392 return eval_skip_value (exp);
c906108c 2393 }
c5aa993b 2394
c906108c
SS
2395 oldpos = *pos;
2396 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2397 *pos = oldpos;
c5aa993b
JM
2398
2399 if (binop_user_defined_p (op, arg1, arg2))
c906108c
SS
2400 {
2401 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2402 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2403 }
2404 else
2405 {
2406 tem = value_logical_not (arg1);
2407 arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2408 (tem ? EVAL_SKIP : noside));
fbb06eb1
UW
2409 type = language_bool_type (exp->language_defn, exp->gdbarch);
2410 return value_from_longest (type,
c5aa993b 2411 (LONGEST) (!tem && !value_logical_not (arg2)));
c906108c
SS
2412 }
2413
2414 case BINOP_LOGICAL_OR:
2415 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2416 if (noside == EVAL_SKIP)
2417 {
262acaeb 2418 evaluate_subexp (NULL_TYPE, exp, pos, noside);
827d0c51 2419 return eval_skip_value (exp);
c906108c 2420 }
c5aa993b 2421
c906108c
SS
2422 oldpos = *pos;
2423 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2424 *pos = oldpos;
c5aa993b
JM
2425
2426 if (binop_user_defined_p (op, arg1, arg2))
c906108c
SS
2427 {
2428 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2429 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2430 }
2431 else
2432 {
2433 tem = value_logical_not (arg1);
2434 arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
2435 (!tem ? EVAL_SKIP : noside));
fbb06eb1
UW
2436 type = language_bool_type (exp->language_defn, exp->gdbarch);
2437 return value_from_longest (type,
c5aa993b 2438 (LONGEST) (!tem || !value_logical_not (arg2)));
c906108c
SS
2439 }
2440
2441 case BINOP_EQUAL:
2442 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2443 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c 2444 if (noside == EVAL_SKIP)
827d0c51 2445 return eval_skip_value (exp);
c906108c
SS
2446 if (binop_user_defined_p (op, arg1, arg2))
2447 {
2448 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2449 }
2450 else
2451 {
f44316fa 2452 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
c906108c 2453 tem = value_equal (arg1, arg2);
fbb06eb1
UW
2454 type = language_bool_type (exp->language_defn, exp->gdbarch);
2455 return value_from_longest (type, (LONGEST) tem);
c906108c
SS
2456 }
2457
2458 case BINOP_NOTEQUAL:
2459 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2460 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c 2461 if (noside == EVAL_SKIP)
827d0c51 2462 return eval_skip_value (exp);
c906108c
SS
2463 if (binop_user_defined_p (op, arg1, arg2))
2464 {
2465 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2466 }
2467 else
2468 {
f44316fa 2469 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
c906108c 2470 tem = value_equal (arg1, arg2);
fbb06eb1
UW
2471 type = language_bool_type (exp->language_defn, exp->gdbarch);
2472 return value_from_longest (type, (LONGEST) ! tem);
c906108c
SS
2473 }
2474
2475 case BINOP_LESS:
2476 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2477 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c 2478 if (noside == EVAL_SKIP)
827d0c51 2479 return eval_skip_value (exp);
c906108c
SS
2480 if (binop_user_defined_p (op, arg1, arg2))
2481 {
2482 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2483 }
2484 else
2485 {
f44316fa 2486 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
c906108c 2487 tem = value_less (arg1, arg2);
fbb06eb1
UW
2488 type = language_bool_type (exp->language_defn, exp->gdbarch);
2489 return value_from_longest (type, (LONGEST) tem);
c906108c
SS
2490 }
2491
2492 case BINOP_GTR:
2493 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2494 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c 2495 if (noside == EVAL_SKIP)
827d0c51 2496 return eval_skip_value (exp);
c906108c
SS
2497 if (binop_user_defined_p (op, arg1, arg2))
2498 {
2499 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2500 }
2501 else
2502 {
f44316fa 2503 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
c906108c 2504 tem = value_less (arg2, arg1);
fbb06eb1
UW
2505 type = language_bool_type (exp->language_defn, exp->gdbarch);
2506 return value_from_longest (type, (LONGEST) tem);
c906108c
SS
2507 }
2508
2509 case BINOP_GEQ:
2510 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2511 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c 2512 if (noside == EVAL_SKIP)
827d0c51 2513 return eval_skip_value (exp);
c906108c
SS
2514 if (binop_user_defined_p (op, arg1, arg2))
2515 {
2516 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2517 }
2518 else
2519 {
f44316fa 2520 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
c906108c 2521 tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
fbb06eb1
UW
2522 type = language_bool_type (exp->language_defn, exp->gdbarch);
2523 return value_from_longest (type, (LONGEST) tem);
c906108c
SS
2524 }
2525
2526 case BINOP_LEQ:
2527 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
df407dfe 2528 arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
c906108c 2529 if (noside == EVAL_SKIP)
827d0c51 2530 return eval_skip_value (exp);
c906108c
SS
2531 if (binop_user_defined_p (op, arg1, arg2))
2532 {
2533 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
2534 }
c5aa993b 2535 else
c906108c 2536 {
f44316fa 2537 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
c906108c 2538 tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
fbb06eb1
UW
2539 type = language_bool_type (exp->language_defn, exp->gdbarch);
2540 return value_from_longest (type, (LONGEST) tem);
c906108c
SS
2541 }
2542
2543 case BINOP_REPEAT:
2544 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2545 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2546 if (noside == EVAL_SKIP)
827d0c51 2547 return eval_skip_value (exp);
df407dfe 2548 type = check_typedef (value_type (arg2));
cc63428a
AV
2549 if (TYPE_CODE (type) != TYPE_CODE_INT
2550 && TYPE_CODE (type) != TYPE_CODE_ENUM)
8a3fe4f8 2551 error (_("Non-integral right operand for \"@\" operator."));
c906108c
SS
2552 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2553 {
df407dfe 2554 return allocate_repeat_value (value_type (arg1),
c5aa993b 2555 longest_to_int (value_as_long (arg2)));
c906108c
SS
2556 }
2557 else
2558 return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
2559
2560 case BINOP_COMMA:
2561 evaluate_subexp (NULL_TYPE, exp, pos, noside);
2562 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2563
36e9969c
NS
2564 case UNOP_PLUS:
2565 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2566 if (noside == EVAL_SKIP)
827d0c51 2567 return eval_skip_value (exp);
36e9969c
NS
2568 if (unop_user_defined_p (op, arg1))
2569 return value_x_unop (arg1, op, noside);
2570 else
f44316fa
UW
2571 {
2572 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2573 return value_pos (arg1);
2574 }
36e9969c 2575
c906108c
SS
2576 case UNOP_NEG:
2577 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2578 if (noside == EVAL_SKIP)
827d0c51 2579 return eval_skip_value (exp);
c906108c
SS
2580 if (unop_user_defined_p (op, arg1))
2581 return value_x_unop (arg1, op, noside);
2582 else
f44316fa
UW
2583 {
2584 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2585 return value_neg (arg1);
2586 }
c906108c
SS
2587
2588 case UNOP_COMPLEMENT:
2589 /* C++: check for and handle destructor names. */
c906108c
SS
2590
2591 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2592 if (noside == EVAL_SKIP)
827d0c51 2593 return eval_skip_value (exp);
c906108c
SS
2594 if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
2595 return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
2596 else
f44316fa
UW
2597 {
2598 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
2599 return value_complement (arg1);
2600 }
c906108c
SS
2601
2602 case UNOP_LOGICAL_NOT:
2603 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2604 if (noside == EVAL_SKIP)
827d0c51 2605 return eval_skip_value (exp);
c906108c
SS
2606 if (unop_user_defined_p (op, arg1))
2607 return value_x_unop (arg1, op, noside);
2608 else
fbb06eb1
UW
2609 {
2610 type = language_bool_type (exp->language_defn, exp->gdbarch);
2611 return value_from_longest (type, (LONGEST) value_logical_not (arg1));
2612 }
c906108c
SS
2613
2614 case UNOP_IND:
2615 if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
c5aa993b 2616 expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
c906108c 2617 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
0d5de010
DJ
2618 type = check_typedef (value_type (arg1));
2619 if (TYPE_CODE (type) == TYPE_CODE_METHODPTR
2620 || TYPE_CODE (type) == TYPE_CODE_MEMBERPTR)
3e43a32a
MS
2621 error (_("Attempt to dereference pointer "
2622 "to member without an object"));
c906108c 2623 if (noside == EVAL_SKIP)
827d0c51 2624 return eval_skip_value (exp);
c906108c
SS
2625 if (unop_user_defined_p (op, arg1))
2626 return value_x_unop (arg1, op, noside);
2627 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2628 {
df407dfe 2629 type = check_typedef (value_type (arg1));
c906108c 2630 if (TYPE_CODE (type) == TYPE_CODE_PTR
aa006118 2631 || TYPE_IS_REFERENCE (type)
c5aa993b 2632 /* In C you can dereference an array to get the 1st elt. */
c906108c 2633 || TYPE_CODE (type) == TYPE_CODE_ARRAY
c5aa993b 2634 )
c906108c
SS
2635 return value_zero (TYPE_TARGET_TYPE (type),
2636 lval_memory);
2637 else if (TYPE_CODE (type) == TYPE_CODE_INT)
2638 /* GDB allows dereferencing an int. */
22fe0fbb
UW
2639 return value_zero (builtin_type (exp->gdbarch)->builtin_int,
2640 lval_memory);
c906108c 2641 else
8a3fe4f8 2642 error (_("Attempt to take contents of a non-pointer value."));
c906108c 2643 }
22fe0fbb
UW
2644
2645 /* Allow * on an integer so we can cast it to whatever we want.
2646 This returns an int, which seems like the most C-like thing to
2647 do. "long long" variables are rare enough that
2648 BUILTIN_TYPE_LONGEST would seem to be a mistake. */
2649 if (TYPE_CODE (type) == TYPE_CODE_INT)
2650 return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
2651 (CORE_ADDR) value_as_address (arg1));
c906108c
SS
2652 return value_ind (arg1);
2653
2654 case UNOP_ADDR:
2655 /* C++: check for and handle pointer to members. */
c5aa993b 2656
c906108c
SS
2657 if (noside == EVAL_SKIP)
2658 {
0d5de010 2659 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
827d0c51 2660 return eval_skip_value (exp);
c906108c 2661 }
c5aa993b
JM
2662 else
2663 {
3e43a32a
MS
2664 struct value *retvalp = evaluate_subexp_for_address (exp, pos,
2665 noside);
d7f9d729 2666
c5aa993b
JM
2667 return retvalp;
2668 }
2669
c906108c
SS
2670 case UNOP_SIZEOF:
2671 if (noside == EVAL_SKIP)
2672 {
2673 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
827d0c51 2674 return eval_skip_value (exp);
c906108c 2675 }
5ecaaa66 2676 return evaluate_subexp_for_sizeof (exp, pos, noside);
c906108c
SS
2677
2678 case UNOP_CAST:
2679 (*pos) += 2;
2680 type = exp->elts[pc + 1].type;
46a4882b 2681 return evaluate_subexp_for_cast (exp, pos, noside, type);
c906108c 2682
9eaf6705
TT
2683 case UNOP_CAST_TYPE:
2684 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2685 type = value_type (arg1);
46a4882b 2686 return evaluate_subexp_for_cast (exp, pos, noside, type);
9eaf6705 2687
4e8f195d 2688 case UNOP_DYNAMIC_CAST:
9eaf6705
TT
2689 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2690 type = value_type (arg1);
4e8f195d
TT
2691 arg1 = evaluate_subexp (type, exp, pos, noside);
2692 if (noside == EVAL_SKIP)
827d0c51 2693 return eval_skip_value (exp);
4e8f195d
TT
2694 return value_dynamic_cast (type, arg1);
2695
2696 case UNOP_REINTERPRET_CAST:
9eaf6705
TT
2697 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2698 type = value_type (arg1);
4e8f195d
TT
2699 arg1 = evaluate_subexp (type, exp, pos, noside);
2700 if (noside == EVAL_SKIP)
827d0c51 2701 return eval_skip_value (exp);
4e8f195d
TT
2702 return value_reinterpret_cast (type, arg1);
2703
c906108c
SS
2704 case UNOP_MEMVAL:
2705 (*pos) += 2;
2706 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2707 if (noside == EVAL_SKIP)
827d0c51 2708 return eval_skip_value (exp);
c906108c
SS
2709 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2710 return value_zero (exp->elts[pc + 1].type, lval_memory);
2711 else
2712 return value_at_lazy (exp->elts[pc + 1].type,
00a4c844 2713 value_as_address (arg1));
c906108c 2714
9eaf6705
TT
2715 case UNOP_MEMVAL_TYPE:
2716 arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2717 type = value_type (arg1);
2718 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2719 if (noside == EVAL_SKIP)
827d0c51 2720 return eval_skip_value (exp);
9eaf6705 2721 if (noside == EVAL_AVOID_SIDE_EFFECTS)
4f485ebc 2722 return value_zero (type, lval_memory);
9eaf6705 2723 else
4f485ebc 2724 return value_at_lazy (type, value_as_address (arg1));
9eaf6705 2725
c906108c
SS
2726 case UNOP_PREINCREMENT:
2727 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2728 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2729 return arg1;
2730 else if (unop_user_defined_p (op, arg1))
2731 {
2732 return value_x_unop (arg1, op, noside);
2733 }
2734 else
2735 {
cc73bb8c 2736 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2497b498 2737 arg2 = value_ptradd (arg1, 1);
89eef114 2738 else
f44316fa
UW
2739 {
2740 struct value *tmp = arg1;
d7f9d729 2741
18a46dbe 2742 arg2 = value_one (value_type (arg1));
f44316fa
UW
2743 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2744 arg2 = value_binop (tmp, arg2, BINOP_ADD);
2745 }
89eef114 2746
c906108c
SS
2747 return value_assign (arg1, arg2);
2748 }
2749
2750 case UNOP_PREDECREMENT:
2751 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2752 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2753 return arg1;
2754 else if (unop_user_defined_p (op, arg1))
2755 {
2756 return value_x_unop (arg1, op, noside);
2757 }
2758 else
2759 {
cc73bb8c 2760 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2497b498 2761 arg2 = value_ptradd (arg1, -1);
89eef114 2762 else
f44316fa
UW
2763 {
2764 struct value *tmp = arg1;
d7f9d729 2765
18a46dbe 2766 arg2 = value_one (value_type (arg1));
f44316fa
UW
2767 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2768 arg2 = value_binop (tmp, arg2, BINOP_SUB);
2769 }
89eef114 2770
c906108c
SS
2771 return value_assign (arg1, arg2);
2772 }
2773
2774 case UNOP_POSTINCREMENT:
2775 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2776 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2777 return arg1;
2778 else if (unop_user_defined_p (op, arg1))
2779 {
2780 return value_x_unop (arg1, op, noside);
2781 }
2782 else
2783 {
c37f7098
KW
2784 arg3 = value_non_lval (arg1);
2785
cc73bb8c 2786 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2497b498 2787 arg2 = value_ptradd (arg1, 1);
89eef114 2788 else
f44316fa
UW
2789 {
2790 struct value *tmp = arg1;
d7f9d729 2791
18a46dbe 2792 arg2 = value_one (value_type (arg1));
f44316fa
UW
2793 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2794 arg2 = value_binop (tmp, arg2, BINOP_ADD);
2795 }
89eef114 2796
c906108c 2797 value_assign (arg1, arg2);
c37f7098 2798 return arg3;
c906108c
SS
2799 }
2800
2801 case UNOP_POSTDECREMENT:
2802 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2803 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2804 return arg1;
2805 else if (unop_user_defined_p (op, arg1))
2806 {
2807 return value_x_unop (arg1, op, noside);
2808 }
2809 else
2810 {
c37f7098
KW
2811 arg3 = value_non_lval (arg1);
2812
cc73bb8c 2813 if (ptrmath_type_p (exp->language_defn, value_type (arg1)))
2497b498 2814 arg2 = value_ptradd (arg1, -1);
89eef114 2815 else
f44316fa
UW
2816 {
2817 struct value *tmp = arg1;
d7f9d729 2818
18a46dbe 2819 arg2 = value_one (value_type (arg1));
f44316fa
UW
2820 binop_promote (exp->language_defn, exp->gdbarch, &tmp, &arg2);
2821 arg2 = value_binop (tmp, arg2, BINOP_SUB);
2822 }
89eef114 2823
c906108c 2824 value_assign (arg1, arg2);
c37f7098 2825 return arg3;
c906108c 2826 }
c5aa993b 2827
c906108c
SS
2828 case OP_THIS:
2829 (*pos) += 1;
85bc8cb7 2830 return value_of_this (exp->language_defn);
a9fa03de 2831
c906108c 2832 case OP_TYPE:
d843c49c
FF
2833 /* The value is not supposed to be used. This is here to make it
2834 easier to accommodate expressions that contain types. */
2835 (*pos) += 2;
2836 if (noside == EVAL_SKIP)
827d0c51 2837 return eval_skip_value (exp);
d843c49c 2838 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
c973d0aa 2839 return allocate_value (exp->elts[pc + 1].type);
d843c49c
FF
2840 else
2841 error (_("Attempt to use a type name as an expression"));
c906108c 2842
608b4967
TT
2843 case OP_TYPEOF:
2844 case OP_DECLTYPE:
2845 if (noside == EVAL_SKIP)
2846 {
2847 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
827d0c51 2848 return eval_skip_value (exp);
608b4967
TT
2849 }
2850 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
2851 {
2852 enum exp_opcode sub_op = exp->elts[*pos].opcode;
2853 struct value *result;
2854
2855 result = evaluate_subexp (NULL_TYPE, exp, pos,
2856 EVAL_AVOID_SIDE_EFFECTS);
2857
2858 /* 'decltype' has special semantics for lvalues. */
2859 if (op == OP_DECLTYPE
2860 && (sub_op == BINOP_SUBSCRIPT
2861 || sub_op == STRUCTOP_MEMBER
2862 || sub_op == STRUCTOP_MPTR
2863 || sub_op == UNOP_IND
2864 || sub_op == STRUCTOP_STRUCT
2865 || sub_op == STRUCTOP_PTR
2866 || sub_op == OP_SCOPE))
2867 {
2868 struct type *type = value_type (result);
2869
aa006118 2870 if (!TYPE_IS_REFERENCE (type))
608b4967 2871 {
3b224330 2872 type = lookup_lvalue_reference_type (type);
608b4967
TT
2873 result = allocate_value (type);
2874 }
2875 }
2876
2877 return result;
2878 }
2879 else
2880 error (_("Attempt to use a type as an expression"));
2881
6e72ca20
TT
2882 case OP_TYPEID:
2883 {
2884 struct value *result;
2885 enum exp_opcode sub_op = exp->elts[*pos].opcode;
2886
2887 if (sub_op == OP_TYPE || sub_op == OP_DECLTYPE || sub_op == OP_TYPEOF)
2888 result = evaluate_subexp (NULL_TYPE, exp, pos,
2889 EVAL_AVOID_SIDE_EFFECTS);
2890 else
2891 result = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2892
2893 if (noside != EVAL_NORMAL)
2894 return allocate_value (cplus_typeid_type (exp->gdbarch));
2895
2896 return cplus_typeid (result);
2897 }
2898
c906108c
SS
2899 default:
2900 /* Removing this case and compiling with gcc -Wall reveals that
c5aa993b 2901 a lot of cases are hitting this case. Some of these should
2df3850c
JM
2902 probably be removed from expression.h; others are legitimate
2903 expressions which are (apparently) not fully implemented.
c906108c 2904
c5aa993b
JM
2905 If there are any cases landing here which mean a user error,
2906 then they should be separate cases, with more descriptive
2907 error messages. */
c906108c 2908
3e43a32a
MS
2909 error (_("GDB does not (yet) know how to "
2910 "evaluate that kind of expression"));
c906108c
SS
2911 }
2912
827d0c51 2913 gdb_assert_not_reached ("missed return?");
c906108c
SS
2914}
2915\f
2916/* Evaluate a subexpression of EXP, at index *POS,
2917 and return the address of that subexpression.
2918 Advance *POS over the subexpression.
2919 If the subexpression isn't an lvalue, get an error.
2920 NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2921 then only the type of the result need be correct. */
2922
61051030 2923static struct value *
aa1ee363 2924evaluate_subexp_for_address (struct expression *exp, int *pos,
fba45db2 2925 enum noside noside)
c906108c
SS
2926{
2927 enum exp_opcode op;
52f0bd74 2928 int pc;
c906108c 2929 struct symbol *var;
ab5c9f60 2930 struct value *x;
0d5de010 2931 int tem;
c906108c
SS
2932
2933 pc = (*pos);
2934 op = exp->elts[pc].opcode;
2935
2936 switch (op)
2937 {
2938 case UNOP_IND:
2939 (*pos)++;
ab5c9f60
DJ
2940 x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2941
2942 /* We can't optimize out "&*" if there's a user-defined operator*. */
2943 if (unop_user_defined_p (op, x))
2944 {
2945 x = value_x_unop (x, op, noside);
0d5de010 2946 goto default_case_after_eval;
ab5c9f60
DJ
2947 }
2948
708ead4e 2949 return coerce_array (x);
c906108c
SS
2950
2951 case UNOP_MEMVAL:
2952 (*pos) += 3;
2953 return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2954 evaluate_subexp (NULL_TYPE, exp, pos, noside));
2955
9eaf6705
TT
2956 case UNOP_MEMVAL_TYPE:
2957 {
2958 struct type *type;
2959
2960 (*pos) += 1;
2961 x = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2962 type = value_type (x);
2963 return value_cast (lookup_pointer_type (type),
2964 evaluate_subexp (NULL_TYPE, exp, pos, noside));
2965 }
2966
c906108c
SS
2967 case OP_VAR_VALUE:
2968 var = exp->elts[pc + 2].symbol;
2969
2970 /* C++: The "address" of a reference should yield the address
0963b4bd 2971 * of the object pointed to. Let value_addr() deal with it. */
aa006118 2972 if (TYPE_IS_REFERENCE (SYMBOL_TYPE (var)))
c5aa993b 2973 goto default_case;
c906108c
SS
2974
2975 (*pos) += 4;
2976 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2977 {
2978 struct type *type =
d7f9d729 2979 lookup_pointer_type (SYMBOL_TYPE (var));
c906108c
SS
2980 enum address_class sym_class = SYMBOL_CLASS (var);
2981
2982 if (sym_class == LOC_CONST
2983 || sym_class == LOC_CONST_BYTES
2a2d4dc3 2984 || sym_class == LOC_REGISTER)
8a3fe4f8 2985 error (_("Attempt to take address of register or constant."));
c906108c 2986
c5aa993b
JM
2987 return
2988 value_zero (type, not_lval);
c906108c 2989 }
ceef53c1 2990 else
61212c0f 2991 return address_of_variable (var, exp->elts[pc + 1].block);
c906108c 2992
46a4882b
PA
2993 case OP_VAR_MSYM_VALUE:
2994 {
2995 (*pos) += 4;
2996
2997 value *val = evaluate_var_msym_value (noside,
2998 exp->elts[pc + 1].objfile,
2999 exp->elts[pc + 2].msymbol);
3000 if (noside == EVAL_AVOID_SIDE_EFFECTS)
3001 {
3002 struct type *type = lookup_pointer_type (value_type (val));
3003 return value_zero (type, not_lval);
3004 }
3005 else
3006 return value_addr (val);
3007 }
3008
0d5de010
DJ
3009 case OP_SCOPE:
3010 tem = longest_to_int (exp->elts[pc + 2].longconst);
3011 (*pos) += 5 + BYTES_TO_EXP_ELEM (tem + 1);
3012 x = value_aggregate_elt (exp->elts[pc + 1].type,
3013 &exp->elts[pc + 3].string,
072bba3b 3014 NULL, 1, noside);
0d5de010
DJ
3015 if (x == NULL)
3016 error (_("There is no field named %s"), &exp->elts[pc + 3].string);
3017 return x;
3018
c906108c
SS
3019 default:
3020 default_case:
ab5c9f60 3021 x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
0d5de010 3022 default_case_after_eval:
c906108c
SS
3023 if (noside == EVAL_AVOID_SIDE_EFFECTS)
3024 {
0d5de010
DJ
3025 struct type *type = check_typedef (value_type (x));
3026
aa006118 3027 if (TYPE_IS_REFERENCE (type))
0d5de010
DJ
3028 return value_zero (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
3029 not_lval);
4819b3f8
PA
3030 else if (VALUE_LVAL (x) == lval_memory || value_must_coerce_to_target (x))
3031 return value_zero (lookup_pointer_type (value_type (x)),
3032 not_lval);
c906108c 3033 else
3e43a32a
MS
3034 error (_("Attempt to take address of "
3035 "value not located in memory."));
c906108c 3036 }
ab5c9f60 3037 return value_addr (x);
c906108c
SS
3038 }
3039}
3040
3041/* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
3042 When used in contexts where arrays will be coerced anyway, this is
3043 equivalent to `evaluate_subexp' but much faster because it avoids
3044 actually fetching array contents (perhaps obsolete now that we have
d69fe07e 3045 value_lazy()).
c906108c
SS
3046
3047 Note that we currently only do the coercion for C expressions, where
3048 arrays are zero based and the coercion is correct. For other languages,
3049 with nonzero based arrays, coercion loses. Use CAST_IS_CONVERSION
0963b4bd 3050 to decide if coercion is appropriate. */
c906108c 3051
61051030 3052struct value *
aa1ee363
AC
3053evaluate_subexp_with_coercion (struct expression *exp,
3054 int *pos, enum noside noside)
c906108c 3055{
52f0bd74
AC
3056 enum exp_opcode op;
3057 int pc;
61051030 3058 struct value *val;
c906108c 3059 struct symbol *var;
61212c0f 3060 struct type *type;
c906108c
SS
3061
3062 pc = (*pos);
3063 op = exp->elts[pc].opcode;
3064
3065 switch (op)
3066 {
3067 case OP_VAR_VALUE:
3068 var = exp->elts[pc + 2].symbol;
61212c0f
UW
3069 type = check_typedef (SYMBOL_TYPE (var));
3070 if (TYPE_CODE (type) == TYPE_CODE_ARRAY
7346b668 3071 && !TYPE_VECTOR (type)
cc73bb8c 3072 && CAST_IS_CONVERSION (exp->language_defn))
c906108c
SS
3073 {
3074 (*pos) += 4;
61212c0f
UW
3075 val = address_of_variable (var, exp->elts[pc + 1].block);
3076 return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
c906108c
SS
3077 val);
3078 }
3079 /* FALLTHROUGH */
3080
3081 default:
3082 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
3083 }
3084}
3085
3086/* Evaluate a subexpression of EXP, at index *POS,
3087 and return a value for the size of that subexpression.
5ecaaa66
SA
3088 Advance *POS over the subexpression. If NOSIDE is EVAL_NORMAL
3089 we allow side-effects on the operand if its type is a variable
3090 length array. */
c906108c 3091
61051030 3092static struct value *
5ecaaa66
SA
3093evaluate_subexp_for_sizeof (struct expression *exp, int *pos,
3094 enum noside noside)
c906108c 3095{
98b90dd8
UW
3096 /* FIXME: This should be size_t. */
3097 struct type *size_type = builtin_type (exp->gdbarch)->builtin_int;
c906108c 3098 enum exp_opcode op;
52f0bd74 3099 int pc;
c906108c 3100 struct type *type;
61051030 3101 struct value *val;
c906108c
SS
3102
3103 pc = (*pos);
3104 op = exp->elts[pc].opcode;
3105
3106 switch (op)
3107 {
3108 /* This case is handled specially
c5aa993b
JM
3109 so that we avoid creating a value for the result type.
3110 If the result type is very big, it's desirable not to
3111 create a value unnecessarily. */
c906108c
SS
3112 case UNOP_IND:
3113 (*pos)++;
3114 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
df407dfe 3115 type = check_typedef (value_type (val));
c906108c 3116 if (TYPE_CODE (type) != TYPE_CODE_PTR
aa006118 3117 && !TYPE_IS_REFERENCE (type)
c906108c 3118 && TYPE_CODE (type) != TYPE_CODE_ARRAY)
8a3fe4f8 3119 error (_("Attempt to take contents of a non-pointer value."));
6b662e19 3120 type = TYPE_TARGET_TYPE (type);
3c8452d4
SA
3121 if (is_dynamic_type (type))
3122 type = value_type (value_ind (val));
3123 return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
c906108c
SS
3124
3125 case UNOP_MEMVAL:
3126 (*pos) += 3;
245a5f0b
KS
3127 type = exp->elts[pc + 1].type;
3128 break;
c906108c 3129
9eaf6705
TT
3130 case UNOP_MEMVAL_TYPE:
3131 (*pos) += 1;
3132 val = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
245a5f0b
KS
3133 type = value_type (val);
3134 break;
9eaf6705 3135
c906108c 3136 case OP_VAR_VALUE:
6b662e19 3137 type = SYMBOL_TYPE (exp->elts[pc + 2].symbol);
4ad88275
SA
3138 if (is_dynamic_type (type))
3139 {
3140 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3141 type = value_type (val);
3142 }
3143 else
3144 (*pos) += 4;
245a5f0b 3145 break;
c906108c 3146
46a4882b
PA
3147 case OP_VAR_MSYM_VALUE:
3148 {
3149 (*pos) += 4;
3150
3151 minimal_symbol *msymbol = exp->elts[pc + 2].msymbol;
3152 value *val = evaluate_var_msym_value (noside,
3153 exp->elts[pc + 1].objfile,
3154 msymbol);
3155
3156 type = value_type (val);
3157 if (TYPE_CODE (type) == TYPE_CODE_ERROR)
3158 error_unknown_type (MSYMBOL_PRINT_NAME (msymbol));
3159
3160 return value_from_longest (size_type, TYPE_LENGTH (type));
3161 }
3162 break;
3163
5ecaaa66
SA
3164 /* Deal with the special case if NOSIDE is EVAL_NORMAL and the resulting
3165 type of the subscript is a variable length array type. In this case we
3166 must re-evaluate the right hand side of the subcription to allow
3167 side-effects. */
3168 case BINOP_SUBSCRIPT:
3169 if (noside == EVAL_NORMAL)
3170 {
3171 int pc = (*pos) + 1;
3172
3173 val = evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
3174 type = check_typedef (value_type (val));
3175 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3176 {
3177 type = check_typedef (TYPE_TARGET_TYPE (type));
3178 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
3179 {
3180 type = TYPE_INDEX_TYPE (type);
3181 /* Only re-evaluate the right hand side if the resulting type
3182 is a variable length type. */
3183 if (TYPE_RANGE_DATA (type)->flag_bound_evaluated)
3184 {
3185 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
3186 return value_from_longest
3187 (size_type, (LONGEST) TYPE_LENGTH (value_type (val)));
3188 }
3189 }
3190 }
3191 }
3192
3193 /* Fall through. */
3194
c906108c
SS
3195 default:
3196 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
245a5f0b
KS
3197 type = value_type (val);
3198 break;
c906108c 3199 }
245a5f0b
KS
3200
3201 /* $5.3.3/2 of the C++ Standard (n3290 draft) says of sizeof:
3202 "When applied to a reference or a reference type, the result is
3203 the size of the referenced type." */
f168693b 3204 type = check_typedef (type);
245a5f0b 3205 if (exp->language_defn->la_language == language_cplus
aa006118 3206 && (TYPE_IS_REFERENCE (type)))
245a5f0b
KS
3207 type = check_typedef (TYPE_TARGET_TYPE (type));
3208 return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
c906108c
SS
3209}
3210
46a4882b
PA
3211/* Evaluate a subexpression of EXP, at index *POS, and return a value
3212 for that subexpression cast to TO_TYPE. Advance *POS over the
3213 subexpression. */
3214
3215static value *
3216evaluate_subexp_for_cast (expression *exp, int *pos,
3217 enum noside noside,
3218 struct type *to_type)
3219{
3220 int pc = *pos;
3221
3222 /* Don't let symbols be evaluated with evaluate_subexp because that
3223 throws an "unknown type" error for no-debug data symbols.
3224 Instead, we want the cast to reinterpret the symbol. */
3225 if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE
3226 || exp->elts[pc].opcode == OP_VAR_VALUE)
3227 {
3228 (*pos) += 4;
3229
3230 value *val;
3231 if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
3232 {
3233 if (noside == EVAL_AVOID_SIDE_EFFECTS)
3234 return value_zero (to_type, not_lval);
3235
3236 val = evaluate_var_msym_value (noside,
3237 exp->elts[pc + 1].objfile,
3238 exp->elts[pc + 2].msymbol);
3239 }
3240 else
3241 val = evaluate_var_value (noside,
3242 exp->elts[pc + 1].block,
3243 exp->elts[pc + 2].symbol);
3244
3245 if (noside == EVAL_SKIP)
3246 return eval_skip_value (exp);
3247
3248 val = value_cast (to_type, val);
3249
3250 /* Don't allow e.g. '&(int)var_with_no_debug_info'. */
3251 if (VALUE_LVAL (val) == lval_memory)
3252 {
3253 if (value_lazy (val))
3254 value_fetch_lazy (val);
3255 VALUE_LVAL (val) = not_lval;
3256 }
3257 return val;
3258 }
3259
3260 value *val = evaluate_subexp (to_type, exp, pos, noside);
3261 if (noside == EVAL_SKIP)
3262 return eval_skip_value (exp);
3263 return value_cast (to_type, val);
3264}
3265
0963b4bd 3266/* Parse a type expression in the string [P..P+LENGTH). */
c906108c
SS
3267
3268struct type *
fba45db2 3269parse_and_eval_type (char *p, int length)
c906108c 3270{
c5aa993b 3271 char *tmp = (char *) alloca (length + 4);
d7f9d729 3272
c5aa993b
JM
3273 tmp[0] = '(';
3274 memcpy (tmp + 1, p, length);
3275 tmp[length + 1] = ')';
3276 tmp[length + 2] = '0';
3277 tmp[length + 3] = '\0';
4d01a485 3278 expression_up expr = parse_expression (tmp);
c5aa993b 3279 if (expr->elts[0].opcode != UNOP_CAST)
8a3fe4f8 3280 error (_("Internal error in eval_type."));
c5aa993b 3281 return expr->elts[1].type;
c906108c
SS
3282}
3283
3284int
fba45db2 3285calc_f77_array_dims (struct type *array_type)
c906108c
SS
3286{
3287 int ndimen = 1;
3288 struct type *tmp_type;
3289
c5aa993b 3290 if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
8a3fe4f8 3291 error (_("Can't get dimensions for a non-array type"));
c5aa993b
JM
3292
3293 tmp_type = array_type;
c906108c
SS
3294
3295 while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
3296 {
3297 if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
3298 ++ndimen;
3299 }
c5aa993b 3300 return ndimen;
c906108c 3301}
This page took 1.520401 seconds and 4 git commands to generate.