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