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