1 /* Evaluate expressions for GDB.
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.
6
7 This file is part of GDB.
8
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
13
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
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"
32 #include "language.h" /* For CAST_IS_CONVERSION */
33 #include "f-lang.h" /* for array bound stuff */
34 #include "cp-abi.h"
35 #include "infcall.h"
36 #include "objc-lang.h"
37 #include "block.h"
38 #include "parser-defs.h"
39
40 /* This is defined in valops.c */
41 extern int overload_resolution;
42
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. */
45 extern int objectprint;
46
47 /* Prototypes for local functions. */
48
49 static struct value *evaluate_subexp_for_sizeof (struct expression *, int *);
50
51 static struct value *evaluate_subexp_for_address (struct expression *,
52 int *, enum noside);
53
54 static struct value *evaluate_subexp (struct type *, struct expression *,
55 int *, enum noside);
56
57 static char *get_label (struct expression *, int *);
58
59 static struct value *evaluate_struct_tuple (struct value *,
60 struct expression *, int *,
61 enum noside, int);
62
63 static LONGEST init_array_element (struct value *, struct value *,
64 struct expression *, int *, enum noside,
65 LONGEST, LONGEST);
66
67 static struct value *
evaluate_subexp(struct type * expect_type,struct expression * exp,int * pos,enum noside noside)68 evaluate_subexp (struct type *expect_type, struct expression *exp,
69 int *pos, enum noside noside)
70 {
71 return (*exp->language_defn->la_exp_desc->evaluate_exp)
72 (expect_type, exp, pos, noside);
73 }
74
75 /* Parse the string EXP as a C expression, evaluate it,
76 and return the result as a number. */
77
78 CORE_ADDR
parse_and_eval_address(char * exp)79 parse_and_eval_address (char *exp)
80 {
81 struct expression *expr = parse_expression (exp);
82 CORE_ADDR addr;
83 struct cleanup *old_chain =
84 make_cleanup (free_current_contents, &expr);
85
86 addr = value_as_address (evaluate_expression (expr));
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
94 CORE_ADDR
parse_and_eval_address_1(char ** expptr)95 parse_and_eval_address_1 (char **expptr)
96 {
97 struct expression *expr = parse_exp_1 (expptr, (struct block *) 0, 0);
98 CORE_ADDR addr;
99 struct cleanup *old_chain =
100 make_cleanup (free_current_contents, &expr);
101
102 addr = value_as_address (evaluate_expression (expr));
103 do_cleanups (old_chain);
104 return addr;
105 }
106
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 */
109 LONGEST
parse_and_eval_long(char * exp)110 parse_and_eval_long (char *exp)
111 {
112 struct expression *expr = parse_expression (exp);
113 LONGEST retval;
114 struct cleanup *old_chain =
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
122 struct value *
parse_and_eval(char * exp)123 parse_and_eval (char *exp)
124 {
125 struct expression *expr = parse_expression (exp);
126 struct value *val;
127 struct cleanup *old_chain =
128 make_cleanup (free_current_contents, &expr);
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
139 struct value *
parse_to_comma_and_eval(char ** expp)140 parse_to_comma_and_eval (char **expp)
141 {
142 struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
143 struct value *val;
144 struct cleanup *old_chain =
145 make_cleanup (free_current_contents, &expr);
146
147 val = evaluate_expression (expr);
148 do_cleanups (old_chain);
149 return val;
150 }
151
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
157 struct value *
evaluate_expression(struct expression * exp)158 evaluate_expression (struct expression *exp)
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
167 struct value *
evaluate_type(struct expression * exp)168 evaluate_type (struct expression *exp)
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
177 static char *
get_label(struct expression * exp,int * pos)178 get_label (struct expression *exp, int *pos)
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
192 /* This function evaluates tuples (in (the deleted) Chill) or
193 brace-initializers (in C/C++) for structure types. */
194
195 static struct value *
evaluate_struct_tuple(struct value * struct_val,struct expression * exp,int * pos,enum noside noside,int nargs)196 evaluate_struct_tuple (struct value *struct_val,
197 struct expression *exp,
198 int *pos, enum noside noside, int nargs)
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;
206 while (--nargs >= 0)
207 {
208 int pc = *pos;
209 struct value *val = NULL;
210 int nlabels = 0;
211 int bitpos, bitsize;
212 char *addr;
213
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);
227 if (field_name != NULL && DEPRECATED_STREQ (field_name, label))
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)
250 {
251 for (subfieldno = 0;
252 subfieldno < TYPE_NFIELDS (substruct_type);
253 subfieldno++)
254 {
255 if (DEPRECATED_STREQ (TYPE_FIELD_NAME (substruct_type,
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)));
325 }
326 while (--nlabels > 0);
327 }
328 return struct_val;
329 }
330
331 /* Recursive helper function for setting elements of array tuples for
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. */
337
338 static LONGEST
init_array_element(struct value * array,struct value * element,struct expression * exp,int * pos,enum noside noside,LONGEST low_bound,LONGEST high_bound)339 init_array_element (struct value *array, struct value *element,
340 struct expression *exp, int *pos,
341 enum noside noside, LONGEST low_bound, LONGEST high_bound)
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");
361 for (index = low; index <= high; index++)
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
379 struct value *
evaluate_subexp_standard(struct type * expect_type,struct expression * exp,int * pos,enum noside noside)380 evaluate_subexp_standard (struct type *expect_type,
381 struct expression *exp, int *pos,
382 enum noside noside)
383 {
384 enum exp_opcode op;
385 int tem, tem2, tem3;
386 int pc, pc2 = 0, oldpos;
387 struct value *arg1 = NULL;
388 struct value *arg2 = NULL;
389 struct value *arg3;
390 struct type *type;
391 int nargs;
392 struct value **argvec;
393 int upper, lower, retcode;
394 int code;
395 int ix;
396 long mem_offset;
397 struct type **arg_types;
398 int save_pos1;
399
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);
408 arg1 = value_aggregate_elt (exp->elts[pc + 1].type,
409 &exp->elts[pc + 3].string,
410 noside);
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;
429
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. */
438
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 {
449 int regno = longest_to_int (exp->elts[pc + 1].longconst);
450 struct value *val = value_of_register (regno, get_selected_frame ());
451 (*pos) += 2;
452 if (val == NULL)
453 error ("Value of register %s not available.",
454 frame_map_regnum_to_name (get_selected_frame (), regno));
455 else
456 return val;
457 }
458 case OP_BOOL:
459 (*pos) += 2;
460 return value_from_longest (LA_BOOL_TYPE,
461 exp->elts[pc + 1].longconst);
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
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
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 {
502 struct value *rec = allocate_value (expect_type);
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);
512 struct value *array = allocate_value (expect_type);
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));
522 for (tem = nargs; --nargs >= 0;)
523 {
524 struct value *element;
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 {
560 struct value *set = allocate_value (expect_type);
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;
578 struct value *elem_val;
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
596 different types. Also check if type of element is "compatible"
597 with element type of powerset */
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;
620 for (; range_low <= range_high; range_low++)
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;
625 valaddr[(unsigned) range_low / TARGET_CHAR_BIT]
626 |= 1 << bit_index;
627 }
628 }
629 return set;
630 }
631
632 argvec = (struct value **) alloca (sizeof (struct value *) * nargs);
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 {
644 struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
645 int lowbound
646 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
647 int upper
648 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
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 {
656 struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
657 int lowbound
658 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
659 int length
660 = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
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
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
697 static CORE_ADDR responds_selector = 0;
698 static CORE_ADDR method_selector = 0;
699
700 CORE_ADDR selector = 0;
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 {
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
757 msg_send = find_function_in_inferior ("objc_msg_lookup");
758 msg_send_stret = find_function_in_inferior ("objc_msg_lookup");
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));
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
866 struct_return = using_struct_return (value_type, using_gcc);
867 }
868 else if (expect_type != NULL)
869 {
870 struct_return = using_struct_return (check_typedef (expect_type), using_gcc);
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 {
947 /* Function objc_msg_lookup returns a pointer. */
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);
951 }
952
953 ret = call_function_by_hand (argvec[0], nargs + 2, argvec + 1);
954 return ret;
955 }
956 break;
957
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
963 called in argvec[0] and a terminating NULL */
964 argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 3));
965 if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
966 {
967 LONGEST fnptr;
968
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. */
972 if (deprecated_hp_som_som_object_present)
973 {
974 error ("Not implemented: function invocation through pointer to method with HP aCC");
975 }
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
1003 if (METHOD_PTR_IS_VIRTUAL (fnptr))
1004 {
1005 int fnoffset = METHOD_PTR_TO_VOFFSET (fnptr);
1006 struct type *basetype;
1007 struct type *domain_type =
1008 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
1009 int i, j;
1010 basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
1011 if (domain_type != basetype)
1012 arg2 = value_cast (lookup_pointer_type (domain_type), arg2);
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 {
1022 struct value *temp = value_ind (arg2);
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
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. */
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 {
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),
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;
1112 char tstr[256];
1113
1114 /* Method invocation : stuff "this" as first parameter */
1115 argvec[1] = arg2;
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 */
1122 struct value *valp = NULL;
1123
1124 /* Prepare list of argument types for overload resolution */
1125 arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
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 */ ,
1131 &arg2 /* the object */ , NULL,
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 {
1141 struct value *temp = arg2;
1142 argvec[0] = value_struct_elt (&temp, argvec + 1, tstr,
1143 &static_memfuncp,
1144 op == STRUCTOP_STRUCT
1145 ? "structure" : "structure pointer");
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));
1152 argvec[1] = arg2; /* the ``this'' pointer */
1153 }
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 }
1167 else if (op == OP_VAR_VALUE)
1168 {
1169 /* Non-member function being called */
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 */
1173
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 */
1180 arg_types = (struct type **) alloca (nargs * (sizeof (struct type *)));
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 */ ,
1186 NULL, exp->elts[save_pos1+2].symbol /* the function */ ,
1187 NULL, &symp, NULL);
1188
1189 /* Now fix the expression being evaluated */
1190 exp->elts[save_pos1+2].symbol = symp;
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 }
1199 else
1200 {
1201 /* It is probably a C-style function */
1202 /* nothing to be done; argvec already correctly set up */
1203 }
1204
1205 do_call_it:
1206
1207 if (noside == EVAL_SKIP)
1208 goto nosideret;
1209 if (argvec[0] == NULL)
1210 error ("Cannot evaluate function -- may be inlined");
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 =
1221 TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
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 }
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
1231 case OP_F77_UNDETERMINED_ARGLIST:
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.
1238 If it is a function, we process just as if we got an OP_FUNCALL. */
1239
1240 nargs = longest_to_int (exp->elts[pc + 1].longconst);
1241 (*pos) += 2;
1242
1243 /* First determine the type code we are dealing with. */
1244 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1245 type = check_typedef (VALUE_TYPE (arg1));
1246 code = TYPE_CODE (type);
1247
1248 switch (code)
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 */
1261 argvec = (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
1262 argvec[0] = arg1;
1263 tem = 1;
1264 for (; tem <= nargs; tem++)
1265 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
1266 argvec[tem] = 0; /* signal end of arglist */
1267 goto do_call_it;
1268
1269 default:
1270 error ("Cannot perform substring on this type");
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)
1287 goto nosideret;
1288
1289 tem2 = value_as_long (arg2);
1290 tem3 = value_as_long (arg3);
1291
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
1296 point numbers that compose it */
1297 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1298 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
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 {
1315 struct value *temp = arg1;
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;
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
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 {
1358 struct value *temp = arg1;
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
1367 /* With HP aCC, pointers to methods do not point to the function code */
1368 if (deprecated_hp_som_som_object_present &&
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
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
1380 /* With HP aCC, pointers to methods do not point to the function code */
1381 if (deprecated_hp_som_som_object_present &&
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 */
1385
1386 mem_offset = value_as_long (arg2);
1387
1388 handle_pointer_to_member:
1389 /* HP aCC generates offsets that have bit #29 set; turn it off to get
1390 a real offset to the member. */
1391 if (deprecated_hp_som_som_object_present)
1392 {
1393 if (!mem_offset) /* no bias -> really null */
1394 error ("Attempted dereference of null pointer-to-member");
1395 mem_offset &= ~0x20000000;
1396 }
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);
1410 arg3 = value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
1411 value_as_long (arg1) + mem_offset);
1412 return value_ind (arg3);
1413 bad_pointer_to_member:
1414 error ("non-pointer-to-member value used in pointer-to-member construct");
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
1430 /* Do special stuff for HP aCC pointers to members */
1431 if (deprecated_hp_som_som_object_present)
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
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);
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);
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
1530 {
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);
1551 }
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);
1559
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
1583 type (like a plain int variable for example), then report this
1584 as an error. */
1585
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 }
1599
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:
1612 {
1613 int subscript_array[MAX_FORTRAN_DIMS];
1614 int array_size_array[MAX_FORTRAN_DIMS];
1615 int ndimensions = 1, i;
1616 struct type *tmp_type;
1617 int offset_item; /* The array offset where the item lives */
1618
1619 if (nargs > MAX_FORTRAN_DIMS)
1620 error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
1621
1622 tmp_type = check_typedef (VALUE_TYPE (arg1));
1623 ndimensions = calc_f77_array_dims (type);
1624
1625 if (nargs != ndimensions)
1626 error ("Wrong number of subscripts");
1627
1628 /* Now that we know we have a legal array subscript expression
1629 let us actually find out where this element exists in the array. */
1630
1631 offset_item = 0;
1632 /* Take array indices left to right */
1633 for (i = 0; i < nargs; i++)
1634 {
1635 /* Evaluate each subscript, It must be a legal integer in F77 */
1636 arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
1637
1638 /* Fill in the subscript and array size arrays */
1639
1640 subscript_array[i] = value_as_long (arg2);
1641 }
1642
1643 /* Internal type of array is arranged right to left */
1644 for (i = 0; i < nargs; i++)
1645 {
1646 retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
1647 if (retcode == BOUND_FETCH_ERROR)
1648 error ("Cannot obtain dynamic upper bound");
1649
1650 retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
1651 if (retcode == BOUND_FETCH_ERROR)
1652 error ("Cannot obtain dynamic lower bound");
1653
1654 array_size_array[nargs - i - 1] = upper - lower + 1;
1655
1656 /* Zero-normalize subscripts so that offsetting will work. */
1657
1658 subscript_array[nargs - i - 1] -= lower;
1659
1660 /* If we are at the bottom of a multidimensional
1661 array type then keep a ptr to the last ARRAY
1662 type around for use when calling value_subscript()
1663 below. This is done because we pretend to value_subscript
1664 that we actually have a one-dimensional array
1665 of base element type that we apply a simple
1666 offset to. */
1667
1668 if (i < nargs - 1)
1669 tmp_type = check_typedef (TYPE_TARGET_TYPE (tmp_type));
1670 }
1671
1672 /* Now let us calculate the offset for this item */
1673
1674 offset_item = subscript_array[ndimensions - 1];
1675
1676 for (i = ndimensions - 1; i > 0; --i)
1677 offset_item =
1678 array_size_array[i - 1] * offset_item + subscript_array[i - 1];
1679
1680 /* Construct a value node with the value of the offset */
1681
1682 arg2 = value_from_longest (builtin_type_f_integer, offset_item);
1683
1684 /* Let us now play a dirty trick: we will take arg1
1685 which is a value node pointing to the topmost level
1686 of the multidimensional array-set and pretend
1687 that it is actually a array of the final element
1688 type, this will ensure that value_subscript()
1689 returns the correct type value */
1690
1691 VALUE_TYPE (arg1) = tmp_type;
1692 return value_ind (value_add (value_coerce_array (arg1), arg2));
1693 }
1694
1695 case BINOP_LOGICAL_AND:
1696 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1697 if (noside == EVAL_SKIP)
1698 {
1699 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1700 goto nosideret;
1701 }
1702
1703 oldpos = *pos;
1704 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1705 *pos = oldpos;
1706
1707 if (binop_user_defined_p (op, arg1, arg2))
1708 {
1709 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1710 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1711 }
1712 else
1713 {
1714 tem = value_logical_not (arg1);
1715 arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1716 (tem ? EVAL_SKIP : noside));
1717 return value_from_longest (LA_BOOL_TYPE,
1718 (LONGEST) (!tem && !value_logical_not (arg2)));
1719 }
1720
1721 case BINOP_LOGICAL_OR:
1722 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1723 if (noside == EVAL_SKIP)
1724 {
1725 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1726 goto nosideret;
1727 }
1728
1729 oldpos = *pos;
1730 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
1731 *pos = oldpos;
1732
1733 if (binop_user_defined_p (op, arg1, arg2))
1734 {
1735 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1736 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1737 }
1738 else
1739 {
1740 tem = value_logical_not (arg1);
1741 arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
1742 (!tem ? EVAL_SKIP : noside));
1743 return value_from_longest (LA_BOOL_TYPE,
1744 (LONGEST) (!tem || !value_logical_not (arg2)));
1745 }
1746
1747 case BINOP_EQUAL:
1748 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1749 arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1750 if (noside == EVAL_SKIP)
1751 goto nosideret;
1752 if (binop_user_defined_p (op, arg1, arg2))
1753 {
1754 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1755 }
1756 else
1757 {
1758 tem = value_equal (arg1, arg2);
1759 return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1760 }
1761
1762 case BINOP_NOTEQUAL:
1763 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1764 arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1765 if (noside == EVAL_SKIP)
1766 goto nosideret;
1767 if (binop_user_defined_p (op, arg1, arg2))
1768 {
1769 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1770 }
1771 else
1772 {
1773 tem = value_equal (arg1, arg2);
1774 return value_from_longest (LA_BOOL_TYPE, (LONGEST) ! tem);
1775 }
1776
1777 case BINOP_LESS:
1778 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1779 arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1780 if (noside == EVAL_SKIP)
1781 goto nosideret;
1782 if (binop_user_defined_p (op, arg1, arg2))
1783 {
1784 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1785 }
1786 else
1787 {
1788 tem = value_less (arg1, arg2);
1789 return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1790 }
1791
1792 case BINOP_GTR:
1793 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1794 arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1795 if (noside == EVAL_SKIP)
1796 goto nosideret;
1797 if (binop_user_defined_p (op, arg1, arg2))
1798 {
1799 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1800 }
1801 else
1802 {
1803 tem = value_less (arg2, arg1);
1804 return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1805 }
1806
1807 case BINOP_GEQ:
1808 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1809 arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1810 if (noside == EVAL_SKIP)
1811 goto nosideret;
1812 if (binop_user_defined_p (op, arg1, arg2))
1813 {
1814 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1815 }
1816 else
1817 {
1818 tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
1819 return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1820 }
1821
1822 case BINOP_LEQ:
1823 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1824 arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
1825 if (noside == EVAL_SKIP)
1826 goto nosideret;
1827 if (binop_user_defined_p (op, arg1, arg2))
1828 {
1829 return value_x_binop (arg1, arg2, op, OP_NULL, noside);
1830 }
1831 else
1832 {
1833 tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
1834 return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
1835 }
1836
1837 case BINOP_REPEAT:
1838 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1839 arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1840 if (noside == EVAL_SKIP)
1841 goto nosideret;
1842 type = check_typedef (VALUE_TYPE (arg2));
1843 if (TYPE_CODE (type) != TYPE_CODE_INT)
1844 error ("Non-integral right operand for \"@\" operator.");
1845 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1846 {
1847 return allocate_repeat_value (VALUE_TYPE (arg1),
1848 longest_to_int (value_as_long (arg2)));
1849 }
1850 else
1851 return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
1852
1853 case BINOP_COMMA:
1854 evaluate_subexp (NULL_TYPE, exp, pos, noside);
1855 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
1856
1857 case UNOP_NEG:
1858 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1859 if (noside == EVAL_SKIP)
1860 goto nosideret;
1861 if (unop_user_defined_p (op, arg1))
1862 return value_x_unop (arg1, op, noside);
1863 else
1864 return value_neg (arg1);
1865
1866 case UNOP_COMPLEMENT:
1867 /* C++: check for and handle destructor names. */
1868 op = exp->elts[*pos].opcode;
1869
1870 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1871 if (noside == EVAL_SKIP)
1872 goto nosideret;
1873 if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
1874 return value_x_unop (arg1, UNOP_COMPLEMENT, noside);
1875 else
1876 return value_complement (arg1);
1877
1878 case UNOP_LOGICAL_NOT:
1879 arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1880 if (noside == EVAL_SKIP)
1881 goto nosideret;
1882 if (unop_user_defined_p (op, arg1))
1883 return value_x_unop (arg1, op, noside);
1884 else
1885 return value_from_longest (LA_BOOL_TYPE,
1886 (LONGEST) value_logical_not (arg1));
1887
1888 case UNOP_IND:
1889 if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1890 expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1891 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1892 if ((TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) &&
1893 ((TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_METHOD) ||
1894 (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1))) == TYPE_CODE_MEMBER)))
1895 error ("Attempt to dereference pointer to member without an object");
1896 if (noside == EVAL_SKIP)
1897 goto nosideret;
1898 if (unop_user_defined_p (op, arg1))
1899 return value_x_unop (arg1, op, noside);
1900 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1901 {
1902 type = check_typedef (VALUE_TYPE (arg1));
1903 if (TYPE_CODE (type) == TYPE_CODE_PTR
1904 || TYPE_CODE (type) == TYPE_CODE_REF
1905 /* In C you can dereference an array to get the 1st elt. */
1906 || TYPE_CODE (type) == TYPE_CODE_ARRAY
1907 )
1908 return value_zero (TYPE_TARGET_TYPE (type),
1909 lval_memory);
1910 else if (TYPE_CODE (type) == TYPE_CODE_INT)
1911 /* GDB allows dereferencing an int. */
1912 return value_zero (builtin_type_int, lval_memory);
1913 else
1914 error ("Attempt to take contents of a non-pointer value.");
1915 }
1916 return value_ind (arg1);
1917
1918 case UNOP_ADDR:
1919 /* C++: check for and handle pointer to members. */
1920
1921 op = exp->elts[*pos].opcode;
1922
1923 if (noside == EVAL_SKIP)
1924 {
1925 if (op == OP_SCOPE)
1926 {
1927 int temm = longest_to_int (exp->elts[pc + 3].longconst);
1928 (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
1929 }
1930 else
1931 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1932 goto nosideret;
1933 }
1934 else
1935 {
1936 struct value *retvalp = evaluate_subexp_for_address (exp, pos, noside);
1937 /* If HP aCC object, use bias for pointers to members */
1938 if (deprecated_hp_som_som_object_present &&
1939 (TYPE_CODE (VALUE_TYPE (retvalp)) == TYPE_CODE_PTR) &&
1940 (TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (retvalp))) == TYPE_CODE_MEMBER))
1941 {
1942 unsigned int *ptr = (unsigned int *) VALUE_CONTENTS (retvalp); /* forces evaluation */
1943 *ptr |= 0x20000000; /* set 29th bit */
1944 }
1945 return retvalp;
1946 }
1947
1948 case UNOP_SIZEOF:
1949 if (noside == EVAL_SKIP)
1950 {
1951 evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1952 goto nosideret;
1953 }
1954 return evaluate_subexp_for_sizeof (exp, pos);
1955
1956 case UNOP_CAST:
1957 (*pos) += 2;
1958 type = exp->elts[pc + 1].type;
1959 arg1 = evaluate_subexp (type, exp, pos, noside);
1960 if (noside == EVAL_SKIP)
1961 goto nosideret;
1962 if (type != VALUE_TYPE (arg1))
1963 arg1 = value_cast (type, arg1);
1964 return arg1;
1965
1966 case UNOP_MEMVAL:
1967 (*pos) += 2;
1968 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1969 if (noside == EVAL_SKIP)
1970 goto nosideret;
1971 if (noside == EVAL_AVOID_SIDE_EFFECTS)
1972 return value_zero (exp->elts[pc + 1].type, lval_memory);
1973 else
1974 return value_at_lazy (exp->elts[pc + 1].type,
1975 value_as_address (arg1),
1976 NULL);
1977
1978 case UNOP_PREINCREMENT:
1979 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1980 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1981 return arg1;
1982 else if (unop_user_defined_p (op, arg1))
1983 {
1984 return value_x_unop (arg1, op, noside);
1985 }
1986 else
1987 {
1988 arg2 = value_add (arg1, value_from_longest (builtin_type_char,
1989 (LONGEST) 1));
1990 return value_assign (arg1, arg2);
1991 }
1992
1993 case UNOP_PREDECREMENT:
1994 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1995 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
1996 return arg1;
1997 else if (unop_user_defined_p (op, arg1))
1998 {
1999 return value_x_unop (arg1, op, noside);
2000 }
2001 else
2002 {
2003 arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2004 (LONGEST) 1));
2005 return value_assign (arg1, arg2);
2006 }
2007
2008 case UNOP_POSTINCREMENT:
2009 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2010 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2011 return arg1;
2012 else if (unop_user_defined_p (op, arg1))
2013 {
2014 return value_x_unop (arg1, op, noside);
2015 }
2016 else
2017 {
2018 arg2 = value_add (arg1, value_from_longest (builtin_type_char,
2019 (LONGEST) 1));
2020 value_assign (arg1, arg2);
2021 return arg1;
2022 }
2023
2024 case UNOP_POSTDECREMENT:
2025 arg1 = evaluate_subexp (expect_type, exp, pos, noside);
2026 if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
2027 return arg1;
2028 else if (unop_user_defined_p (op, arg1))
2029 {
2030 return value_x_unop (arg1, op, noside);
2031 }
2032 else
2033 {
2034 arg2 = value_sub (arg1, value_from_longest (builtin_type_char,
2035 (LONGEST) 1));
2036 value_assign (arg1, arg2);
2037 return arg1;
2038 }
2039
2040 case OP_THIS:
2041 (*pos) += 1;
2042 return value_of_this (1);
2043
2044 case OP_OBJC_SELF:
2045 (*pos) += 1;
2046 return value_of_local ("self", 1);
2047
2048 case OP_TYPE:
2049 error ("Attempt to use a type name as an expression");
2050
2051 default:
2052 /* Removing this case and compiling with gcc -Wall reveals that
2053 a lot of cases are hitting this case. Some of these should
2054 probably be removed from expression.h; others are legitimate
2055 expressions which are (apparently) not fully implemented.
2056
2057 If there are any cases landing here which mean a user error,
2058 then they should be separate cases, with more descriptive
2059 error messages. */
2060
2061 error ("\
2062 GDB does not (yet) know how to evaluate that kind of expression");
2063 }
2064
2065 nosideret:
2066 return value_from_longest (builtin_type_long, (LONGEST) 1);
2067 }
2068
2069 /* Evaluate a subexpression of EXP, at index *POS,
2070 and return the address of that subexpression.
2071 Advance *POS over the subexpression.
2072 If the subexpression isn't an lvalue, get an error.
2073 NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
2074 then only the type of the result need be correct. */
2075
2076 static struct value *
evaluate_subexp_for_address(struct expression * exp,int * pos,enum noside noside)2077 evaluate_subexp_for_address (struct expression *exp, int *pos,
2078 enum noside noside)
2079 {
2080 enum exp_opcode op;
2081 int pc;
2082 struct symbol *var;
2083
2084 pc = (*pos);
2085 op = exp->elts[pc].opcode;
2086
2087 switch (op)
2088 {
2089 case UNOP_IND:
2090 (*pos)++;
2091 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2092
2093 case UNOP_MEMVAL:
2094 (*pos) += 3;
2095 return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
2096 evaluate_subexp (NULL_TYPE, exp, pos, noside));
2097
2098 case OP_VAR_VALUE:
2099 var = exp->elts[pc + 2].symbol;
2100
2101 /* C++: The "address" of a reference should yield the address
2102 * of the object pointed to. Let value_addr() deal with it. */
2103 if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
2104 goto default_case;
2105
2106 (*pos) += 4;
2107 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2108 {
2109 struct type *type =
2110 lookup_pointer_type (SYMBOL_TYPE (var));
2111 enum address_class sym_class = SYMBOL_CLASS (var);
2112
2113 if (sym_class == LOC_CONST
2114 || sym_class == LOC_CONST_BYTES
2115 || sym_class == LOC_REGISTER
2116 || sym_class == LOC_REGPARM)
2117 error ("Attempt to take address of register or constant.");
2118
2119 return
2120 value_zero (type, not_lval);
2121 }
2122 else
2123 return
2124 locate_var_value
2125 (var,
2126 block_innermost_frame (exp->elts[pc + 1].block));
2127
2128 default:
2129 default_case:
2130 if (noside == EVAL_AVOID_SIDE_EFFECTS)
2131 {
2132 struct value *x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
2133 if (VALUE_LVAL (x) == lval_memory)
2134 return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
2135 not_lval);
2136 else
2137 error ("Attempt to take address of non-lval");
2138 }
2139 return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
2140 }
2141 }
2142
2143 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
2144 When used in contexts where arrays will be coerced anyway, this is
2145 equivalent to `evaluate_subexp' but much faster because it avoids
2146 actually fetching array contents (perhaps obsolete now that we have
2147 VALUE_LAZY).
2148
2149 Note that we currently only do the coercion for C expressions, where
2150 arrays are zero based and the coercion is correct. For other languages,
2151 with nonzero based arrays, coercion loses. Use CAST_IS_CONVERSION
2152 to decide if coercion is appropriate.
2153
2154 */
2155
2156 struct value *
evaluate_subexp_with_coercion(struct expression * exp,int * pos,enum noside noside)2157 evaluate_subexp_with_coercion (struct expression *exp,
2158 int *pos, enum noside noside)
2159 {
2160 enum exp_opcode op;
2161 int pc;
2162 struct value *val;
2163 struct symbol *var;
2164
2165 pc = (*pos);
2166 op = exp->elts[pc].opcode;
2167
2168 switch (op)
2169 {
2170 case OP_VAR_VALUE:
2171 var = exp->elts[pc + 2].symbol;
2172 if (TYPE_CODE (check_typedef (SYMBOL_TYPE (var))) == TYPE_CODE_ARRAY
2173 && CAST_IS_CONVERSION)
2174 {
2175 (*pos) += 4;
2176 val =
2177 locate_var_value
2178 (var, block_innermost_frame (exp->elts[pc + 1].block));
2179 return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (check_typedef (SYMBOL_TYPE (var)))),
2180 val);
2181 }
2182 /* FALLTHROUGH */
2183
2184 default:
2185 return evaluate_subexp (NULL_TYPE, exp, pos, noside);
2186 }
2187 }
2188
2189 /* Evaluate a subexpression of EXP, at index *POS,
2190 and return a value for the size of that subexpression.
2191 Advance *POS over the subexpression. */
2192
2193 static struct value *
evaluate_subexp_for_sizeof(struct expression * exp,int * pos)2194 evaluate_subexp_for_sizeof (struct expression *exp, int *pos)
2195 {
2196 enum exp_opcode op;
2197 int pc;
2198 struct type *type;
2199 struct value *val;
2200
2201 pc = (*pos);
2202 op = exp->elts[pc].opcode;
2203
2204 switch (op)
2205 {
2206 /* This case is handled specially
2207 so that we avoid creating a value for the result type.
2208 If the result type is very big, it's desirable not to
2209 create a value unnecessarily. */
2210 case UNOP_IND:
2211 (*pos)++;
2212 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2213 type = check_typedef (VALUE_TYPE (val));
2214 if (TYPE_CODE (type) != TYPE_CODE_PTR
2215 && TYPE_CODE (type) != TYPE_CODE_REF
2216 && TYPE_CODE (type) != TYPE_CODE_ARRAY)
2217 error ("Attempt to take contents of a non-pointer value.");
2218 type = check_typedef (TYPE_TARGET_TYPE (type));
2219 return value_from_longest (builtin_type_int, (LONGEST)
2220 TYPE_LENGTH (type));
2221
2222 case UNOP_MEMVAL:
2223 (*pos) += 3;
2224 type = check_typedef (exp->elts[pc + 1].type);
2225 return value_from_longest (builtin_type_int,
2226 (LONGEST) TYPE_LENGTH (type));
2227
2228 case OP_VAR_VALUE:
2229 (*pos) += 4;
2230 type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
2231 return
2232 value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
2233
2234 default:
2235 val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
2236 return value_from_longest (builtin_type_int,
2237 (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
2238 }
2239 }
2240
2241 /* Parse a type expression in the string [P..P+LENGTH). */
2242
2243 struct type *
parse_and_eval_type(char * p,int length)2244 parse_and_eval_type (char *p, int length)
2245 {
2246 char *tmp = (char *) alloca (length + 4);
2247 struct expression *expr;
2248 tmp[0] = '(';
2249 memcpy (tmp + 1, p, length);
2250 tmp[length + 1] = ')';
2251 tmp[length + 2] = '0';
2252 tmp[length + 3] = '\0';
2253 expr = parse_expression (tmp);
2254 if (expr->elts[0].opcode != UNOP_CAST)
2255 error ("Internal error in eval_type.");
2256 return expr->elts[1].type;
2257 }
2258
2259 int
calc_f77_array_dims(struct type * array_type)2260 calc_f77_array_dims (struct type *array_type)
2261 {
2262 int ndimen = 1;
2263 struct type *tmp_type;
2264
2265 if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
2266 error ("Can't get dimensions for a non-array type");
2267
2268 tmp_type = array_type;
2269
2270 while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
2271 {
2272 if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
2273 ++ndimen;
2274 }
2275 return ndimen;
2276 }
2277