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