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