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