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