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