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