xref: /openbsd-src/gnu/usr.bin/binutils/gdb/eval.c (revision 63addd46c1e40ca0f49488ddcdc4ab598023b0c1)
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