1 /* Evaluate expressions for GDB.
2 Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994
3 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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., 675 Mass Ave, Cambridge, MA 02139, USA. */
26 #include "expression.h"
30 #include "language.h" /* For CAST_IS_CONVERSION */
31 #include "f-lang.h" /* for array bound stuff */
33 /* Values of NOSIDE argument to eval_subexp. */
38 EVAL_SKIP
, /* Only effect is to increment pos. */
39 EVAL_AVOID_SIDE_EFFECTS
/* Don't modify any variables or
40 call any functions. The value
41 returned will have the correct
42 type, and will have an
43 approximately correct lvalue
44 type (inaccuracy: anything that is
45 listed as being in a register in
46 the function in which it was
47 declared will be lval_register). */
50 /* Prototypes for local functions. */
52 static value_ptr evaluate_subexp_for_sizeof
PARAMS ((struct expression
*,
55 static value_ptr evaluate_subexp_with_coercion
PARAMS ((struct expression
*,
58 static value_ptr evaluate_subexp_for_address
PARAMS ((struct expression
*,
61 static value_ptr evaluate_subexp
PARAMS ((struct type
*, struct expression
*,
65 /* Parse the string EXP as a C expression, evaluate it,
66 and return the result as a number. */
69 parse_and_eval_address (exp
)
72 struct expression
*expr
= parse_expression (exp
);
73 register CORE_ADDR addr
;
74 register struct cleanup
*old_chain
=
75 make_cleanup (free_current_contents
, &expr
);
77 addr
= value_as_pointer (evaluate_expression (expr
));
78 do_cleanups (old_chain
);
82 /* Like parse_and_eval_address but takes a pointer to a char * variable
83 and advanced that variable across the characters parsed. */
86 parse_and_eval_address_1 (expptr
)
89 struct expression
*expr
= parse_exp_1 (expptr
, (struct block
*)0, 0);
90 register CORE_ADDR addr
;
91 register struct cleanup
*old_chain
=
92 make_cleanup (free_current_contents
, &expr
);
94 addr
= value_as_pointer (evaluate_expression (expr
));
95 do_cleanups (old_chain
);
103 struct expression
*expr
= parse_expression (exp
);
104 register value_ptr val
;
105 register struct cleanup
*old_chain
106 = make_cleanup (free_current_contents
, &expr
);
108 val
= evaluate_expression (expr
);
109 do_cleanups (old_chain
);
113 /* Parse up to a comma (or to a closeparen)
114 in the string EXPP as an expression, evaluate it, and return the value.
115 EXPP is advanced to point to the comma. */
118 parse_to_comma_and_eval (expp
)
121 struct expression
*expr
= parse_exp_1 (expp
, (struct block
*) 0, 1);
122 register value_ptr val
;
123 register struct cleanup
*old_chain
124 = make_cleanup (free_current_contents
, &expr
);
126 val
= evaluate_expression (expr
);
127 do_cleanups (old_chain
);
131 /* Evaluate an expression in internal prefix form
132 such as is constructed by parse.y.
134 See expression.h for info on the format of an expression. */
137 evaluate_expression (exp
)
138 struct expression
*exp
;
141 return evaluate_subexp (NULL_TYPE
, exp
, &pc
, EVAL_NORMAL
);
144 /* Evaluate an expression, avoiding all memory references
145 and getting a value whose type alone is correct. */
149 struct expression
*exp
;
152 return evaluate_subexp (NULL_TYPE
, exp
, &pc
, EVAL_AVOID_SIDE_EFFECTS
);
155 /* Helper function called by evaluate_subexp to initialize a field
156 a structure from a tuple in Chill. This is recursive, to handle
157 more than one field name labels.
159 STRUCT_VAL is the structure value we are constructing.
160 (*FIELDNOP) is the field to set, if there is no label.
161 It is set to the field following this one.
162 EXP, POS, and NOSIDE are as for evaluate_subexp.
164 This function does not handle variant records. FIXME */
167 evaluate_labeled_field_init (struct_val
, fieldnop
, exp
, pos
, noside
)
168 value_ptr struct_val
;
170 register struct expression
*exp
;
174 int fieldno
= *fieldnop
;
178 struct type
*struct_type
= VALUE_TYPE (struct_val
);
179 if (exp
->elts
[*pos
].opcode
== OP_LABELED
)
182 char *name
= &exp
->elts
[pc
+ 2].string
;
183 int tem
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
184 (*pos
) += 3 + BYTES_TO_EXP_ELEM (tem
+ 1);
185 for (fieldno
= 0; ; fieldno
++)
187 if (fieldno
>= TYPE_NFIELDS (struct_type
))
188 error ("there is no field named %s", name
);
189 if (STREQ (TYPE_FIELD_NAME (struct_type
, fieldno
), name
))
193 val
= evaluate_labeled_field_init (struct_val
, fieldnop
,
198 fieldno
= (*fieldnop
)++;
199 if (fieldno
>= TYPE_NFIELDS (struct_type
))
200 error ("too many initializers");
201 val
= evaluate_subexp (TYPE_FIELD_TYPE (struct_type
, fieldno
),
205 /* Assign val to field fieldno. */
206 if (VALUE_TYPE (val
) != TYPE_FIELD_TYPE (struct_type
, fieldno
))
207 val
= value_cast (TYPE_FIELD_TYPE (struct_type
, fieldno
), val
);
209 bitsize
= TYPE_FIELD_BITSIZE (struct_type
, fieldno
);
210 bitpos
= TYPE_FIELD_BITPOS (struct_type
, fieldno
);
211 addr
= VALUE_CONTENTS (struct_val
);
214 modify_field (addr
, value_as_long (val
),
215 bitpos
% 8, bitsize
);
217 memcpy (addr
, VALUE_CONTENTS (val
),
218 TYPE_LENGTH (VALUE_TYPE (val
)));
220 value_assign (value_primitive_field (struct_val
, 0, fieldno
, struct_type
),
227 evaluate_subexp (expect_type
, exp
, pos
, noside
)
228 struct type
*expect_type
;
229 register struct expression
*exp
;
235 register int pc
, pc2
= 0, oldpos
;
236 register value_ptr arg1
= NULL
, arg2
= NULL
, arg3
;
240 int tmp_pos
, tmp1_pos
;
241 struct symbol
*tmp_symbol
;
242 int upper
, lower
, retcode
;
244 struct internalvar
*var
;
246 /* This expect_type crap should not be used for C. C expressions do
247 not have any notion of expected types, never has and (goddess
248 willing) never will. The C++ code uses it for some twisted
249 purpose (I haven't investigated but I suspect it just the usual
250 combination of Stroustrup figuring out some crazy language
251 feature and Tiemann figuring out some crazier way to try to
252 implement it). CHILL has the tuple stuff; I don't know enough
253 about CHILL to know whether expected types is the way to do it.
254 FORTRAN I don't know. */
255 if (exp
->language_defn
->la_language
!= language_cplus
256 && exp
->language_defn
->la_language
!= language_chill
)
257 expect_type
= NULL_TYPE
;
260 op
= exp
->elts
[pc
].opcode
;
265 tem
= longest_to_int (exp
->elts
[pc
+ 2].longconst
);
266 (*pos
) += 4 + BYTES_TO_EXP_ELEM (tem
+ 1);
267 arg1
= value_struct_elt_for_reference (exp
->elts
[pc
+ 1].type
,
269 exp
->elts
[pc
+ 1].type
,
270 &exp
->elts
[pc
+ 3].string
,
273 error ("There is no field named %s", &exp
->elts
[pc
+ 3].string
);
278 return value_from_longest (exp
->elts
[pc
+ 1].type
,
279 exp
->elts
[pc
+ 2].longconst
);
283 return value_from_double (exp
->elts
[pc
+ 1].type
,
284 exp
->elts
[pc
+ 2].doubleconst
);
288 if (noside
== EVAL_SKIP
)
290 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
292 struct symbol
* sym
= exp
->elts
[pc
+ 2].symbol
;
295 switch (SYMBOL_CLASS (sym
))
299 case LOC_CONST_BYTES
:
313 return value_zero (SYMBOL_TYPE (sym
), lv
);
316 return value_of_variable (exp
->elts
[pc
+ 2].symbol
,
317 exp
->elts
[pc
+ 1].block
);
322 access_value_history (longest_to_int (exp
->elts
[pc
+ 1].longconst
));
326 return value_of_register (longest_to_int (exp
->elts
[pc
+ 1].longconst
));
330 if (current_language
->la_language
== language_fortran
)
331 return value_from_longest (builtin_type_f_logical_s2
,
332 exp
->elts
[pc
+ 1].longconst
);
334 return value_from_longest (builtin_type_chill_bool
,
335 exp
->elts
[pc
+ 1].longconst
);
339 return value_of_internalvar (exp
->elts
[pc
+ 1].internalvar
);
342 tem
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
343 (*pos
) += 3 + BYTES_TO_EXP_ELEM (tem
+ 1);
344 if (noside
== EVAL_SKIP
)
346 return value_string (&exp
->elts
[pc
+ 2].string
, tem
);
349 error ("support for OP_BITSTRING unimplemented");
354 tem2
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
355 tem3
= longest_to_int (exp
->elts
[pc
+ 2].longconst
);
356 nargs
= tem3
- tem2
+ 1;
358 if (expect_type
!= NULL_TYPE
&& noside
!= EVAL_SKIP
359 && TYPE_CODE (expect_type
) == TYPE_CODE_STRUCT
)
361 value_ptr rec
= allocate_value (expect_type
);
363 memset (VALUE_CONTENTS_RAW (rec
), '\0',
364 TYPE_LENGTH (expect_type
) / TARGET_CHAR_BIT
);
365 for (tem
= 0; tem
< nargs
; tem
++)
366 evaluate_labeled_field_init (rec
, &fieldno
, exp
, pos
, noside
);
370 if (expect_type
!= NULL_TYPE
&& noside
!= EVAL_SKIP
371 && TYPE_CODE (expect_type
) == TYPE_CODE_ARRAY
)
373 struct type
*range_type
= TYPE_FIELD_TYPE (expect_type
, 0);
374 struct type
*element_type
= TYPE_TARGET_TYPE (expect_type
);
375 LONGEST low_bound
= TYPE_FIELD_BITPOS (range_type
, 0);
376 LONGEST high_bound
= TYPE_FIELD_BITPOS (range_type
, 1);
377 int element_size
= TYPE_LENGTH (element_type
);
378 value_ptr rec
= allocate_value (expect_type
);
379 if (nargs
!= (high_bound
- low_bound
+ 1))
380 error ("wrong number of initialiers for array type");
381 for (tem
= low_bound
; tem
<= high_bound
; tem
++)
383 value_ptr element
= evaluate_subexp (element_type
,
385 memcpy (VALUE_CONTENTS_RAW (rec
)
386 + (tem
- low_bound
) * element_size
,
387 VALUE_CONTENTS (element
),
393 if (expect_type
!= NULL_TYPE
&& noside
!= EVAL_SKIP
394 && TYPE_CODE (expect_type
) == TYPE_CODE_SET
)
396 value_ptr set
= allocate_value (expect_type
);
397 struct type
*element_type
= TYPE_INDEX_TYPE (expect_type
);
398 int low_bound
= TYPE_LOW_BOUND (element_type
);
399 int high_bound
= TYPE_HIGH_BOUND (element_type
);
400 char *valaddr
= VALUE_CONTENTS_RAW (set
);
401 memset (valaddr
, '\0', TYPE_LENGTH (expect_type
) / TARGET_CHAR_BIT
);
402 for (tem
= 0; tem
< nargs
; tem
++)
404 value_ptr element_val
= evaluate_subexp (element_type
,
406 /* FIXME check that element_val has appropriate type. */
407 LONGEST element
= value_as_long (element_val
);
409 if (element
< low_bound
|| element
> high_bound
)
410 error ("POWERSET tuple element out of range");
411 element
-= low_bound
;
412 bit_index
= (unsigned) element
% TARGET_CHAR_BIT
;
414 bit_index
= TARGET_CHAR_BIT
- 1 - bit_index
;
415 valaddr
[(unsigned) element
/ TARGET_CHAR_BIT
] |= 1 << bit_index
;
420 argvec
= (value_ptr
*) alloca (sizeof (value_ptr
) * nargs
);
421 for (tem
= 0; tem
< nargs
; tem
++)
423 /* Ensure that array expressions are coerced into pointer objects. */
424 argvec
[tem
] = evaluate_subexp_with_coercion (exp
, pos
, noside
);
426 if (noside
== EVAL_SKIP
)
428 if (current_language
->la_language
== language_fortran
)
429 /* For F77, we need to do special things to literal strings */
430 return (f77_value_literal_string (tem2
, tem3
, argvec
));
431 return value_array (tem2
, tem3
, argvec
);
435 /* Skip third and second args to evaluate the first one. */
436 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
437 if (value_logical_not (arg1
))
439 evaluate_subexp (NULL_TYPE
, exp
, pos
, EVAL_SKIP
);
440 return evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
444 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
445 evaluate_subexp (NULL_TYPE
, exp
, pos
, EVAL_SKIP
);
451 op
= exp
->elts
[*pos
].opcode
;
452 if (op
== STRUCTOP_MEMBER
|| op
== STRUCTOP_MPTR
)
456 nargs
= longest_to_int (exp
->elts
[pc
+ 1].longconst
) + 1;
457 /* First, evaluate the structure into arg2 */
460 if (noside
== EVAL_SKIP
)
463 if (op
== STRUCTOP_MEMBER
)
465 arg2
= evaluate_subexp_for_address (exp
, pos
, noside
);
469 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
472 /* If the function is a virtual function, then the
473 aggregate value (providing the structure) plays
474 its part by providing the vtable. Otherwise,
475 it is just along for the ride: call the function
478 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
480 fnptr
= value_as_long (arg1
);
482 if (METHOD_PTR_IS_VIRTUAL(fnptr
))
484 int fnoffset
= METHOD_PTR_TO_VOFFSET(fnptr
);
485 struct type
*basetype
;
486 struct type
*domain_type
=
487 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1
)));
489 basetype
= TYPE_TARGET_TYPE (VALUE_TYPE (arg2
));
490 if (domain_type
!= basetype
)
491 arg2
= value_cast(lookup_pointer_type (domain_type
), arg2
);
492 basetype
= TYPE_VPTR_BASETYPE (domain_type
);
493 for (i
= TYPE_NFN_FIELDS (basetype
) - 1; i
>= 0; i
--)
495 struct fn_field
*f
= TYPE_FN_FIELDLIST1 (basetype
, i
);
496 /* If one is virtual, then all are virtual. */
497 if (TYPE_FN_FIELD_VIRTUAL_P (f
, 0))
498 for (j
= TYPE_FN_FIELDLIST_LENGTH (basetype
, i
) - 1; j
>= 0; --j
)
499 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == fnoffset
)
501 value_ptr temp
= value_ind (arg2
);
502 arg1
= value_virtual_fn_field (&temp
, f
, j
, domain_type
, 0);
503 arg2
= value_addr (temp
);
508 error ("virtual function at index %d not found", fnoffset
);
512 VALUE_TYPE (arg1
) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1
)));
516 /* Now, say which argument to start evaluating from */
519 else if (op
== STRUCTOP_STRUCT
|| op
== STRUCTOP_PTR
)
521 /* Hair for method invocations */
524 nargs
= longest_to_int (exp
->elts
[pc
+ 1].longconst
) + 1;
525 /* First, evaluate the structure into arg2 */
527 tem2
= longest_to_int (exp
->elts
[pc2
+ 1].longconst
);
528 *pos
+= 3 + BYTES_TO_EXP_ELEM (tem2
+ 1);
529 if (noside
== EVAL_SKIP
)
532 if (op
== STRUCTOP_STRUCT
)
534 /* If v is a variable in a register, and the user types
535 v.method (), this will produce an error, because v has
538 A possible way around this would be to allocate a
539 copy of the variable on the stack, copy in the
540 contents, call the function, and copy out the
541 contents. I.e. convert this from call by reference
542 to call by copy-return (or whatever it's called).
543 However, this does not work because it is not the
544 same: the method being called could stash a copy of
545 the address, and then future uses through that address
546 (after the method returns) would be expected to
547 use the variable itself, not some copy of it. */
548 arg2
= evaluate_subexp_for_address (exp
, pos
, noside
);
552 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
554 /* Now, say which argument to start evaluating from */
559 nargs
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
562 /* Allocate arg vector, including space for the function to be
563 called in argvec[0] and a terminating NULL */
564 argvec
= (value_ptr
*) alloca (sizeof (value_ptr
) * (nargs
+ 2));
565 for (; tem
<= nargs
; tem
++)
566 /* Ensure that array expressions are coerced into pointer objects. */
567 argvec
[tem
] = evaluate_subexp_with_coercion (exp
, pos
, noside
);
569 /* signal end of arglist */
572 if (op
== STRUCTOP_STRUCT
|| op
== STRUCTOP_PTR
)
575 value_ptr temp
= arg2
;
580 strcpy(tstr
, &exp
->elts
[pc2
+2].string
);
585 value_struct_elt (&temp
, argvec
+1, tstr
,
587 op
== STRUCTOP_STRUCT
588 ? "structure" : "structure pointer");
590 arg2
= value_from_longest (lookup_pointer_type(VALUE_TYPE (temp
)),
591 VALUE_ADDRESS (temp
)+VALUE_OFFSET (temp
));
596 argvec
[1] = argvec
[0];
601 else if (op
== STRUCTOP_MEMBER
|| op
== STRUCTOP_MPTR
)
607 if (noside
== EVAL_SKIP
)
609 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
611 /* If the return type doesn't look like a function type, call an
612 error. This can happen if somebody tries to turn a variable into
613 a function call. This is here because people often want to
614 call, eg, strcmp, which gdb doesn't know is a function. If
615 gdb isn't asked for it's opinion (ie. through "whatis"),
616 it won't offer it. */
619 TYPE_TARGET_TYPE (VALUE_TYPE (argvec
[0]));
622 return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec
[0])));
624 error ("Expression of type other than \"Function returning ...\" used as function");
626 return call_function_by_hand (argvec
[0], nargs
, argvec
+ 1);
628 case OP_F77_UNDETERMINED_ARGLIST
:
630 tmp_pos
= pc
; /* Point to this instr */
632 /* Remember that in F77, functions, substring ops and
633 array subscript operations cannot be disambiguated
634 at parse time. We have made all array subscript operations,
635 substring operations as well as function calls come here
636 and we now have to discover what the heck this thing actually was.
637 If it is an array, we massage it into a form that the
638 MULTI_F77_SUBSCRIPT operator can deal with. If it is
639 a function, we process just as if we got an OP_FUNCALL and
640 for a subscring operation, we perform the appropriate
641 substring operation. */
643 /* First get the nargs and then jump all the way over the:
645 OP_UNDETERMINED_ARGLIST
647 OP_UNDETERMINED_ARGLIST
649 instruction sequence */
651 nargs
= longest_to_int (exp
->elts
[tmp_pos
+1].longconst
);
652 tmp_pos
+= 3; /* size(op_funcall) == 3 elts */
654 /* We will always have an OP_VAR_VALUE as the next opcode.
655 The data stored after the OP_VAR_VALUE is the a pointer
656 to the function/array/string symbol. We should now check and
657 make sure that the symbols is an array and not a function.
658 If it is an array type, we have hit a F77 subscript operation and
659 we have to do some magic. If it is not an array, we check
660 to see if we found a string here. If there is a string,
661 we recursively evaluate and let OP_f77_SUBSTR deal with
662 things. If there is no string, we know there is a function
663 call at hand and change OP_FUNCALL_OR_SUBSCRIPT -> OP_FUNCALL.
664 In all cases, we recursively evaluate. */
666 /* First determine the type code we are dealing with. */
668 switch (exp
->elts
[tmp_pos
].opcode
)
671 tmp_pos
+= 1; /* To get to the symbol ptr */
672 tmp_symbol
= exp
->elts
[tmp_pos
].symbol
;
673 code
= TYPE_CODE (SYMBOL_TYPE (tmp_symbol
));
678 var
= exp
->elts
[tmp_pos
].internalvar
;
679 code
= TYPE_CODE(VALUE_TYPE(var
->value
));
682 case OP_F77_UNDETERMINED_ARGLIST
:
683 /* Special case when you do stuff like print ARRAY(1,1)(3:4) */
685 arg2
= evaluate_subexp (NULL_TYPE
, exp
, &tmp1_pos
, noside
);
686 code
=TYPE_CODE (VALUE_TYPE (arg2
));
690 error ("Cannot perform substring on this type");
695 case TYPE_CODE_ARRAY
:
696 /* Transform this into what it really is: a MULTI_F77_SUBSCRIPT */
698 exp
->elts
[tmp_pos
].opcode
= MULTI_F77_SUBSCRIPT
;
699 exp
->elts
[tmp_pos
+2].opcode
= MULTI_F77_SUBSCRIPT
;
702 case TYPE_CODE_LITERAL_STRING
: /* When substring'ing internalvars */
703 case TYPE_CODE_STRING
:
705 exp
->elts
[tmp_pos
].opcode
= OP_F77_SUBSTR
;
706 exp
->elts
[tmp_pos
+2].opcode
= OP_F77_SUBSTR
;
711 /* This is just a regular OP_FUNCALL, transform it
712 and recursively evaluate */
713 tmp_pos
= pc
; /* Point to OP_FUNCALL_OR_SUBSCRIPT */
714 exp
->elts
[tmp_pos
].opcode
= OP_FUNCALL
;
715 exp
->elts
[tmp_pos
+2].opcode
= OP_FUNCALL
;
719 error ("Cannot perform substring on this type");
722 /* Pretend like you never saw this expression */
724 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
728 /* We have a substring operation on our hands here,
729 let us get the string we will be dealing with */
732 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
734 /* Now evaluate the 'from' and 'to' */
736 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
738 if (TYPE_CODE (VALUE_TYPE (arg2
)) != TYPE_CODE_INT
)
739 error ("Substring arguments must be of type integer");
741 arg3
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
743 if (TYPE_CODE (VALUE_TYPE (arg3
)) != TYPE_CODE_INT
)
744 error ("Substring arguments must be of type integer");
746 tem2
= *((int *) VALUE_CONTENTS_RAW (arg2
));
747 tem3
= *((int *) VALUE_CONTENTS_RAW (arg3
));
749 if ((tem2
< 1) || (tem2
> tem3
))
750 error ("Bad 'from' value %d on substring operation", tem2
);
752 if ((tem3
< tem2
) || (tem3
> (TYPE_LENGTH (VALUE_TYPE (arg1
)))))
753 error ("Bad 'to' value %d on substring operation", tem3
);
755 if (noside
== EVAL_SKIP
)
758 return f77_value_substring (arg1
, tem2
, tem3
);
760 case OP_F77_LITERAL_COMPLEX
:
761 /* We have a complex number, There should be 2 floating
762 point numbers that compose it */
763 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
764 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
766 /* Complex*16 is the default size to create */
767 return f77_value_literal_complex (arg1
, arg2
, 16);
769 case STRUCTOP_STRUCT
:
770 tem
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
771 (*pos
) += 3 + BYTES_TO_EXP_ELEM (tem
+ 1);
772 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
773 if (noside
== EVAL_SKIP
)
775 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
776 return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1
),
777 &exp
->elts
[pc
+ 2].string
,
782 value_ptr temp
= arg1
;
783 return value_struct_elt (&temp
, NULL
, &exp
->elts
[pc
+ 2].string
,
788 tem
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
789 (*pos
) += 3 + BYTES_TO_EXP_ELEM (tem
+ 1);
790 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
791 if (noside
== EVAL_SKIP
)
793 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
794 return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1
),
795 &exp
->elts
[pc
+ 2].string
,
800 value_ptr temp
= arg1
;
801 return value_struct_elt (&temp
, NULL
, &exp
->elts
[pc
+ 2].string
,
802 NULL
, "structure pointer");
805 case STRUCTOP_MEMBER
:
806 arg1
= evaluate_subexp_for_address (exp
, pos
, noside
);
807 goto handle_pointer_to_member
;
809 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
810 handle_pointer_to_member
:
811 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
812 if (noside
== EVAL_SKIP
)
814 if (TYPE_CODE (VALUE_TYPE (arg2
)) != TYPE_CODE_PTR
)
815 goto bad_pointer_to_member
;
816 type
= TYPE_TARGET_TYPE (VALUE_TYPE (arg2
));
817 if (TYPE_CODE (type
) == TYPE_CODE_METHOD
)
818 error ("not implemented: pointer-to-method in pointer-to-member construct");
819 if (TYPE_CODE (type
) != TYPE_CODE_MEMBER
)
820 goto bad_pointer_to_member
;
821 /* Now, convert these values to an address. */
822 arg1
= value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type
)),
824 arg3
= value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type
)),
825 value_as_long (arg1
) + value_as_long (arg2
));
826 return value_ind (arg3
);
827 bad_pointer_to_member
:
828 error("non-pointer-to-member value used in pointer-to-member construct");
831 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
832 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
833 if (noside
== EVAL_SKIP
)
835 if (binop_user_defined_p (op
, arg1
, arg2
))
836 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
838 return value_concat (arg1
, arg2
);
841 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
842 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
843 if (noside
== EVAL_SKIP
|| noside
== EVAL_AVOID_SIDE_EFFECTS
)
845 if (binop_user_defined_p (op
, arg1
, arg2
))
846 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
848 return value_assign (arg1
, arg2
);
850 case BINOP_ASSIGN_MODIFY
:
852 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
853 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
854 if (noside
== EVAL_SKIP
|| noside
== EVAL_AVOID_SIDE_EFFECTS
)
856 op
= exp
->elts
[pc
+ 1].opcode
;
857 if (binop_user_defined_p (op
, arg1
, arg2
))
858 return value_x_binop (arg1
, arg2
, BINOP_ASSIGN_MODIFY
, op
);
859 else if (op
== BINOP_ADD
)
860 arg2
= value_add (arg1
, arg2
);
861 else if (op
== BINOP_SUB
)
862 arg2
= value_sub (arg1
, arg2
);
864 arg2
= value_binop (arg1
, arg2
, op
);
865 return value_assign (arg1
, arg2
);
868 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
869 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
870 if (noside
== EVAL_SKIP
)
872 if (binop_user_defined_p (op
, arg1
, arg2
))
873 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
875 return value_add (arg1
, arg2
);
878 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
879 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
880 if (noside
== EVAL_SKIP
)
882 if (binop_user_defined_p (op
, arg1
, arg2
))
883 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
885 return value_sub (arg1
, arg2
);
893 case BINOP_BITWISE_AND
:
894 case BINOP_BITWISE_IOR
:
895 case BINOP_BITWISE_XOR
:
896 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
897 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
898 if (noside
== EVAL_SKIP
)
900 if (binop_user_defined_p (op
, arg1
, arg2
))
901 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
903 if (noside
== EVAL_AVOID_SIDE_EFFECTS
904 && (op
== BINOP_DIV
|| op
== BINOP_REM
|| op
== BINOP_MOD
))
905 return value_zero (VALUE_TYPE (arg1
), not_lval
);
907 return value_binop (arg1
, arg2
, op
);
909 case BINOP_SUBSCRIPT
:
910 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
911 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
912 if (noside
== EVAL_SKIP
)
914 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
916 /* If the user attempts to subscript something that has no target
917 type (like a plain int variable for example), then report this
920 type
= TYPE_TARGET_TYPE (VALUE_TYPE (arg1
));
922 return value_zero (type
, VALUE_LVAL (arg1
));
924 error ("cannot subscript something of type `%s'",
925 TYPE_NAME (VALUE_TYPE (arg1
)));
928 if (binop_user_defined_p (op
, arg1
, arg2
))
929 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
931 return value_subscript (arg1
, arg2
);
934 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
935 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
936 if (noside
== EVAL_SKIP
)
938 return value_in (arg1
, arg2
);
940 case MULTI_SUBSCRIPT
:
942 nargs
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
943 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
946 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
947 /* FIXME: EVAL_SKIP handling may not be correct. */
948 if (noside
== EVAL_SKIP
)
959 /* FIXME: EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
960 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
962 /* If the user attempts to subscript something that has no target
963 type (like a plain int variable for example), then report this
966 type
= TYPE_TARGET_TYPE (VALUE_TYPE (arg1
));
969 arg1
= value_zero (type
, VALUE_LVAL (arg1
));
975 error ("cannot subscript something of type `%s'",
976 TYPE_NAME (VALUE_TYPE (arg1
)));
980 if (binop_user_defined_p (op
, arg1
, arg2
))
982 arg1
= value_x_binop (arg1
, arg2
, op
, OP_NULL
);
986 arg1
= value_subscript (arg1
, arg2
);
991 case MULTI_F77_SUBSCRIPT
:
993 int subscript_array
[MAX_FORTRAN_DIMS
+1]; /* 1-based array of
994 subscripts, max == 7 */
995 int array_size_array
[MAX_FORTRAN_DIMS
+1];
997 struct type
*tmp_type
;
998 int offset_item
; /* The array offset where the item lives */
1002 nargs
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
1004 if (nargs
> MAX_FORTRAN_DIMS
)
1005 error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS
);
1007 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
1009 ndimensions
= calc_f77_array_dims (VALUE_TYPE (arg1
));
1011 if (nargs
!= ndimensions
)
1012 error ("Wrong number of subscripts");
1014 /* Now that we know we have a legal array subscript expression
1015 let us actually find out where this element exists in the array. */
1017 tmp_type
= VALUE_TYPE (arg1
);
1019 for (i
= 1; i
<= nargs
; i
++)
1021 /* Evaluate each subscript, It must be a legal integer in F77 */
1022 arg2
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
1024 if (TYPE_CODE (VALUE_TYPE (arg2
)) != TYPE_CODE_INT
)
1025 error ("Array subscripts must be of type integer");
1027 /* Fill in the subscript and array size arrays */
1029 subscript_array
[i
] = (* (unsigned int *) VALUE_CONTENTS(arg2
));
1031 retcode
= f77_get_dynamic_upperbound (tmp_type
, &upper
);
1032 if (retcode
== BOUND_FETCH_ERROR
)
1033 error ("Cannot obtain dynamic upper bound");
1035 retcode
= f77_get_dynamic_lowerbound (tmp_type
, &lower
);
1036 if (retcode
== BOUND_FETCH_ERROR
)
1037 error("Cannot obtain dynamic lower bound");
1039 array_size_array
[i
] = upper
- lower
+ 1;
1041 /* Zero-normalize subscripts so that offsetting will work. */
1043 subscript_array
[i
] -= lower
;
1045 /* If we are at the bottom of a multidimensional
1046 array type then keep a ptr to the last ARRAY
1047 type around for use when calling value_subscript()
1048 below. This is done because we pretend to value_subscript
1049 that we actually have a one-dimensional array
1050 of base element type that we apply a simple
1054 tmp_type
= TYPE_TARGET_TYPE (tmp_type
);
1057 /* Now let us calculate the offset for this item */
1059 offset_item
= subscript_array
[ndimensions
];
1061 for (i
= ndimensions
- 1; i
>= 1; i
--)
1063 array_size_array
[i
] * offset_item
+ subscript_array
[i
];
1065 /* Construct a value node with the value of the offset */
1067 arg2
= value_from_longest (builtin_type_f_integer
, offset_item
);
1069 /* Let us now play a dirty trick: we will take arg1
1070 which is a value node pointing to the topmost level
1071 of the multidimensional array-set and pretend
1072 that it is actually a array of the final element
1073 type, this will ensure that value_subscript()
1074 returns the correct type value */
1076 VALUE_TYPE (arg1
) = tmp_type
;
1078 arg1
= value_subscript (arg1
, arg2
);
1082 case BINOP_LOGICAL_AND
:
1083 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1084 if (noside
== EVAL_SKIP
)
1086 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1091 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
1094 if (binop_user_defined_p (op
, arg1
, arg2
))
1096 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1097 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1101 tem
= value_logical_not (arg1
);
1102 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
,
1103 (tem
? EVAL_SKIP
: noside
));
1104 return value_from_longest (builtin_type_int
,
1105 (LONGEST
) (!tem
&& !value_logical_not (arg2
)));
1108 case BINOP_LOGICAL_OR
:
1109 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1110 if (noside
== EVAL_SKIP
)
1112 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1117 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
1120 if (binop_user_defined_p (op
, arg1
, arg2
))
1122 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1123 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1127 tem
= value_logical_not (arg1
);
1128 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
,
1129 (!tem
? EVAL_SKIP
: noside
));
1130 return value_from_longest (builtin_type_int
,
1131 (LONGEST
) (!tem
|| !value_logical_not (arg2
)));
1135 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1136 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
1137 if (noside
== EVAL_SKIP
)
1139 if (binop_user_defined_p (op
, arg1
, arg2
))
1141 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1145 tem
= value_equal (arg1
, arg2
);
1146 return value_from_longest (builtin_type_int
, (LONGEST
) tem
);
1149 case BINOP_NOTEQUAL
:
1150 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1151 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
1152 if (noside
== EVAL_SKIP
)
1154 if (binop_user_defined_p (op
, arg1
, arg2
))
1156 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1160 tem
= value_equal (arg1
, arg2
);
1161 return value_from_longest (builtin_type_int
, (LONGEST
) ! tem
);
1165 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1166 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
1167 if (noside
== EVAL_SKIP
)
1169 if (binop_user_defined_p (op
, arg1
, arg2
))
1171 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1175 tem
= value_less (arg1
, arg2
);
1176 return value_from_longest (builtin_type_int
, (LONGEST
) tem
);
1180 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1181 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
1182 if (noside
== EVAL_SKIP
)
1184 if (binop_user_defined_p (op
, arg1
, arg2
))
1186 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1190 tem
= value_less (arg2
, arg1
);
1191 return value_from_longest (builtin_type_int
, (LONGEST
) tem
);
1195 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1196 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
1197 if (noside
== EVAL_SKIP
)
1199 if (binop_user_defined_p (op
, arg1
, arg2
))
1201 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1205 tem
= value_less (arg2
, arg1
) || value_equal (arg1
, arg2
);
1206 return value_from_longest (builtin_type_int
, (LONGEST
) tem
);
1210 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1211 arg2
= evaluate_subexp (VALUE_TYPE (arg1
), exp
, pos
, noside
);
1212 if (noside
== EVAL_SKIP
)
1214 if (binop_user_defined_p (op
, arg1
, arg2
))
1216 return value_x_binop (arg1
, arg2
, op
, OP_NULL
);
1220 tem
= value_less (arg1
, arg2
) || value_equal (arg1
, arg2
);
1221 return value_from_longest (builtin_type_int
, (LONGEST
) tem
);
1225 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1226 arg2
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1227 if (noside
== EVAL_SKIP
)
1229 if (TYPE_CODE (VALUE_TYPE (arg2
)) != TYPE_CODE_INT
)
1230 error ("Non-integral right operand for \"@\" operator.");
1231 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
1232 return allocate_repeat_value (VALUE_TYPE (arg1
),
1233 longest_to_int (value_as_long (arg2
)));
1235 return value_repeat (arg1
, longest_to_int (value_as_long (arg2
)));
1238 evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1239 return evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1242 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1243 if (noside
== EVAL_SKIP
)
1245 if (unop_user_defined_p (op
, arg1
))
1246 return value_x_unop (arg1
, op
);
1248 return value_neg (arg1
);
1250 case UNOP_COMPLEMENT
:
1251 /* C++: check for and handle destructor names. */
1252 op
= exp
->elts
[*pos
].opcode
;
1254 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1255 if (noside
== EVAL_SKIP
)
1257 if (unop_user_defined_p (UNOP_COMPLEMENT
, arg1
))
1258 return value_x_unop (arg1
, UNOP_COMPLEMENT
);
1260 return value_complement (arg1
);
1262 case UNOP_LOGICAL_NOT
:
1263 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1264 if (noside
== EVAL_SKIP
)
1266 if (unop_user_defined_p (op
, arg1
))
1267 return value_x_unop (arg1
, op
);
1269 return value_from_longest (builtin_type_int
,
1270 (LONGEST
) value_logical_not (arg1
));
1273 if (expect_type
&& TYPE_CODE (expect_type
) == TYPE_CODE_PTR
)
1274 expect_type
= TYPE_TARGET_TYPE (expect_type
);
1275 arg1
= evaluate_subexp (expect_type
, exp
, pos
, noside
);
1276 if (noside
== EVAL_SKIP
)
1278 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
1280 if (TYPE_CODE (VALUE_TYPE (arg1
)) == TYPE_CODE_PTR
1281 || TYPE_CODE (VALUE_TYPE (arg1
)) == TYPE_CODE_REF
1282 /* In C you can dereference an array to get the 1st elt. */
1283 || TYPE_CODE (VALUE_TYPE (arg1
)) == TYPE_CODE_ARRAY
1285 return value_zero (TYPE_TARGET_TYPE (VALUE_TYPE (arg1
)),
1287 else if (TYPE_CODE (VALUE_TYPE (arg1
)) == TYPE_CODE_INT
)
1288 /* GDB allows dereferencing an int. */
1289 return value_zero (builtin_type_int
, lval_memory
);
1291 error ("Attempt to take contents of a non-pointer value.");
1293 return value_ind (arg1
);
1296 /* C++: check for and handle pointer to members. */
1298 op
= exp
->elts
[*pos
].opcode
;
1300 if (noside
== EVAL_SKIP
)
1304 int temm
= longest_to_int (exp
->elts
[pc
+3].longconst
);
1305 (*pos
) += 3 + BYTES_TO_EXP_ELEM (temm
+ 1);
1308 evaluate_subexp (expect_type
, exp
, pos
, EVAL_SKIP
);
1312 return evaluate_subexp_for_address (exp
, pos
, noside
);
1315 if (noside
== EVAL_SKIP
)
1317 evaluate_subexp (NULL_TYPE
, exp
, pos
, EVAL_SKIP
);
1320 return evaluate_subexp_for_sizeof (exp
, pos
);
1324 type
= exp
->elts
[pc
+ 1].type
;
1325 arg1
= evaluate_subexp (type
, exp
, pos
, noside
);
1326 if (noside
== EVAL_SKIP
)
1328 if (type
!= VALUE_TYPE (arg1
))
1329 arg1
= value_cast (type
, arg1
);
1334 arg1
= evaluate_subexp (expect_type
, exp
, pos
, noside
);
1335 if (noside
== EVAL_SKIP
)
1337 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
1338 return value_zero (exp
->elts
[pc
+ 1].type
, lval_memory
);
1340 return value_at_lazy (exp
->elts
[pc
+ 1].type
,
1341 value_as_pointer (arg1
));
1343 case UNOP_PREINCREMENT
:
1344 arg1
= evaluate_subexp (expect_type
, exp
, pos
, noside
);
1345 if (noside
== EVAL_SKIP
|| noside
== EVAL_AVOID_SIDE_EFFECTS
)
1347 else if (unop_user_defined_p (op
, arg1
))
1349 return value_x_unop (arg1
, op
);
1353 arg2
= value_add (arg1
, value_from_longest (builtin_type_char
,
1355 return value_assign (arg1
, arg2
);
1358 case UNOP_PREDECREMENT
:
1359 arg1
= evaluate_subexp (expect_type
, exp
, pos
, noside
);
1360 if (noside
== EVAL_SKIP
|| noside
== EVAL_AVOID_SIDE_EFFECTS
)
1362 else if (unop_user_defined_p (op
, arg1
))
1364 return value_x_unop (arg1
, op
);
1368 arg2
= value_sub (arg1
, value_from_longest (builtin_type_char
,
1370 return value_assign (arg1
, arg2
);
1373 case UNOP_POSTINCREMENT
:
1374 arg1
= evaluate_subexp (expect_type
, exp
, pos
, noside
);
1375 if (noside
== EVAL_SKIP
|| noside
== EVAL_AVOID_SIDE_EFFECTS
)
1377 else if (unop_user_defined_p (op
, arg1
))
1379 return value_x_unop (arg1
, op
);
1383 arg2
= value_add (arg1
, value_from_longest (builtin_type_char
,
1385 value_assign (arg1
, arg2
);
1389 case UNOP_POSTDECREMENT
:
1390 arg1
= evaluate_subexp (expect_type
, exp
, pos
, noside
);
1391 if (noside
== EVAL_SKIP
|| noside
== EVAL_AVOID_SIDE_EFFECTS
)
1393 else if (unop_user_defined_p (op
, arg1
))
1395 return value_x_unop (arg1
, op
);
1399 arg2
= value_sub (arg1
, value_from_longest (builtin_type_char
,
1401 value_assign (arg1
, arg2
);
1407 return value_of_this (1);
1410 error ("Attempt to use a type name as an expression");
1413 /* Removing this case and compiling with gcc -Wall reveals that
1414 a lot of cases are hitting this case. Some of these should
1415 probably be removed from expression.h (e.g. do we need a BINOP_SCOPE
1416 and an OP_SCOPE?); others are legitimate expressions which are
1417 (apparently) not fully implemented.
1419 If there are any cases landing here which mean a user error,
1420 then they should be separate cases, with more descriptive
1424 GDB does not (yet) know how to evaluate that kind of expression");
1428 return value_from_longest (builtin_type_long
, (LONGEST
) 1);
1431 /* Evaluate a subexpression of EXP, at index *POS,
1432 and return the address of that subexpression.
1433 Advance *POS over the subexpression.
1434 If the subexpression isn't an lvalue, get an error.
1435 NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
1436 then only the type of the result need be correct. */
1439 evaluate_subexp_for_address (exp
, pos
, noside
)
1440 register struct expression
*exp
;
1449 op
= exp
->elts
[pc
].opcode
;
1455 return evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1459 return value_cast (lookup_pointer_type (exp
->elts
[pc
+ 1].type
),
1460 evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
));
1463 var
= exp
->elts
[pc
+ 2].symbol
;
1465 /* C++: The "address" of a reference should yield the address
1466 * of the object pointed to. Let value_addr() deal with it. */
1467 if (TYPE_CODE (SYMBOL_TYPE (var
)) == TYPE_CODE_REF
)
1471 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
1474 lookup_pointer_type (SYMBOL_TYPE (var
));
1475 enum address_class sym_class
= SYMBOL_CLASS (var
);
1477 if (sym_class
== LOC_CONST
1478 || sym_class
== LOC_CONST_BYTES
1479 || sym_class
== LOC_REGISTER
1480 || sym_class
== LOC_REGPARM
)
1481 error ("Attempt to take address of register or constant.");
1484 value_zero (type
, not_lval
);
1490 block_innermost_frame (exp
->elts
[pc
+ 1].block
));
1494 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
1496 value_ptr x
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1497 if (VALUE_LVAL (x
) == lval_memory
)
1498 return value_zero (lookup_pointer_type (VALUE_TYPE (x
)),
1501 error ("Attempt to take address of non-lval");
1503 return value_addr (evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
));
1507 /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
1508 When used in contexts where arrays will be coerced anyway, this is
1509 equivalent to `evaluate_subexp' but much faster because it avoids
1510 actually fetching array contents (perhaps obsolete now that we have
1513 Note that we currently only do the coercion for C expressions, where
1514 arrays are zero based and the coercion is correct. For other languages,
1515 with nonzero based arrays, coercion loses. Use CAST_IS_CONVERSION
1516 to decide if coercion is appropriate.
1521 evaluate_subexp_with_coercion (exp
, pos
, noside
)
1522 register struct expression
*exp
;
1526 register enum exp_opcode op
;
1528 register value_ptr val
;
1532 op
= exp
->elts
[pc
].opcode
;
1537 var
= exp
->elts
[pc
+ 2].symbol
;
1538 if (TYPE_CODE (SYMBOL_TYPE (var
)) == TYPE_CODE_ARRAY
1539 && CAST_IS_CONVERSION
)
1544 (var
, block_innermost_frame (exp
->elts
[pc
+ 1].block
));
1545 return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (SYMBOL_TYPE (var
))),
1551 return evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
1555 /* Evaluate a subexpression of EXP, at index *POS,
1556 and return a value for the size of that subexpression.
1557 Advance *POS over the subexpression. */
1560 evaluate_subexp_for_sizeof (exp
, pos
)
1561 register struct expression
*exp
;
1569 op
= exp
->elts
[pc
].opcode
;
1573 /* This case is handled specially
1574 so that we avoid creating a value for the result type.
1575 If the result type is very big, it's desirable not to
1576 create a value unnecessarily. */
1579 val
= evaluate_subexp (NULL_TYPE
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
1580 return value_from_longest (builtin_type_int
, (LONGEST
)
1581 TYPE_LENGTH (TYPE_TARGET_TYPE (VALUE_TYPE (val
))));
1585 return value_from_longest (builtin_type_int
,
1586 (LONGEST
) TYPE_LENGTH (exp
->elts
[pc
+ 1].type
));
1593 (LONGEST
) TYPE_LENGTH (SYMBOL_TYPE (exp
->elts
[pc
+ 2].symbol
)));
1596 val
= evaluate_subexp (NULL_TYPE
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
1597 return value_from_longest (builtin_type_int
,
1598 (LONGEST
) TYPE_LENGTH (VALUE_TYPE (val
)));
1602 /* Parse a type expression in the string [P..P+LENGTH). */
1605 parse_and_eval_type (p
, length
)
1609 char *tmp
= (char *)alloca (length
+ 4);
1610 struct expression
*expr
;
1612 memcpy (tmp
+1, p
, length
);
1613 tmp
[length
+1] = ')';
1614 tmp
[length
+2] = '0';
1615 tmp
[length
+3] = '\0';
1616 expr
= parse_expression (tmp
);
1617 if (expr
->elts
[0].opcode
!= UNOP_CAST
)
1618 error ("Internal error in eval_type.");
1619 return expr
->elts
[1].type
;
1623 calc_f77_array_dims (array_type
)
1624 struct type
*array_type
;
1627 struct type
*tmp_type
;
1629 if ((TYPE_CODE(array_type
) != TYPE_CODE_ARRAY
))
1630 error ("Can't get dimensions for a non-array type");
1632 tmp_type
= array_type
;
1634 while (tmp_type
= TYPE_TARGET_TYPE (tmp_type
))
1636 if (TYPE_CODE (tmp_type
) == TYPE_CODE_ARRAY
)