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