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