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